home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Applications / NIH Image 1.60 / 1.60 Source / Utilities.p < prev   
Encoding:
Text File  |  1996-03-01  |  80.6 KB  |  3,381 lines  |  [TEXT/PJMM]
  1. unit Utilities;
  2.  
  3. {Miscellaneous utility routines used by NIH Image}
  4.  
  5. interface
  6.  
  7.    uses
  8.         Types, Memory, QuickDraw, Packages, Devices, Menus, Events, Fonts, Scrap, TextEdit, ToolUtils, Dialogs,
  9.         Controls, Palettes, ColorPicker, Printing, SegLoad, Processes, QuickDrawText, TextUtils, Windows,
  10.                 OSUtils, QDOffscreen, Components, QuickTimeComponents, globals;
  11.  
  12.  
  13.  
  14.     procedure SetDlogItem (TheDialog: DialogPtr; item, value: integer);
  15.     procedure OutlineButton (theDialog: DialogPtr; itemNo, CornerRad: integer);
  16.     function GetDNum (TheDialog: DialogPtr; item: integer): LongInt;
  17.     function GetDString (TheDialog: DialogPtr; item: integer): str255;
  18.     procedure SetDNum (TheDialog: DialogPtr; item: integer; n: LongInt);
  19.     procedure GetWindowRect (w: WindowPtr; var wrect: rect);
  20.     procedure SetDReal (TheDialog: DialogPtr; item: integer; n: extended; fwidth: integer);
  21.     procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
  22.     procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
  23.     function StringToReal (str: str255): extended;
  24.     function GetDReal (TheDialog: DialogPtr; item: integer): extended;
  25.     procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
  26.     procedure DrawReal (Val: extended; width, fwidth: integer);
  27.     procedure DrawJReal (hloc, vloc: integer; Val: extended; fwidth: integer);
  28.     procedure DrawLong (i: LongInt);
  29.     function GetInt (message: str255; default: integer; var Canceled: boolean): integer;
  30.     function GetReal (message: str255; default: extended; precision: integer; var Canceled: boolean): extended;
  31.     function OptionKeyDown: boolean;
  32.     function ShiftKeyDown: boolean;
  33.     function ControlKeyDown: boolean;
  34.     function CommandPeriod: boolean;
  35.     function SpaceBarDown: boolean;
  36.  
  37.     procedure SysResume;
  38.     procedure beep;
  39.     procedure PutMessage (str: str255);
  40.     procedure PutError (str: str255);
  41.     procedure UnprotectLUT;
  42.     procedure LoadLUT (table: MyCSpecArray);
  43.     procedure SetupLutUndo;
  44.     procedure UndoLutChange;
  45.     procedure DisableDensitySlice;
  46.     procedure LoadInputLUT (address: ptr);
  47.     procedure ResetQuickCapture;
  48.     procedure ResetScionLG3;
  49.     procedure ResetScionAG5;
  50.     procedure ResetScionVG5f;
  51.     procedure ResetFrameGrabber;
  52.     procedure CopyOffscreen (src, dst: PixMapHandle; sRect, dRect: rect);
  53.     procedure wait (ticks: LongInt);
  54.     function GetScrapCount: integer;
  55.     procedure DisplayText (update: boolean);
  56.     procedure ScreenToOffscreen (var loc: point);
  57.     procedure OffscreenToScreen (var loc: point);
  58.     procedure OffScreenToScreenRect (var r: rect);
  59.     procedure UpdateScreen (MaskRect: rect);
  60.     procedure RestoreRoi;
  61.     procedure Undo;
  62.     procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
  63.     procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
  64.     function GetFontSize (item: integer): integer;
  65.     function MyGetPixel (h, v: LongInt): integer;
  66.     procedure PutPixel (h, v: LongInt; value: integer);
  67.     procedure GetLine (h, v, count: LongInt; var line: LineType);
  68.     procedure GetColumn (h, v, count: LongInt; var data: LineType);
  69.     procedure PutColumn (hstart, vstart, count: LongInt; var data: LineType);
  70.     procedure PutLine (h, v, count: LongInt; var line: LineType);
  71.     procedure Show1Value (rvalue, CalibratedValue: extended);
  72.     procedure Show2PlotValues (x, y: extended);
  73.     procedure Show2Values (current, total: LongInt);
  74.     procedure DrawXDimension (x: extended; digits: integer);
  75.     procedure DrawYDimension (y: extended; digits: integer);
  76.     procedure DrawRGB (index: integer);
  77.     procedure Show3Values (hloc, vloc, ivalue: LongInt);
  78.     procedure ShowDxDy (X, Y: extended);
  79.     procedure PutChar (c: char);
  80.     procedure PutTab;
  81.     procedure PutString (str: str255);
  82.     procedure PutReal (n: extended; width, fwidth: integer);
  83.     procedure PutLong (n: LongInt; FieldWidth: integer);
  84.     procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
  85.     procedure ShowWatch;
  86.     procedure ShowAnimatedWatch;
  87.     procedure UpdatePicWindow;
  88.     procedure DoOperation (Operation: OpType);
  89.     procedure SaveRoi;
  90.     procedure KillRoi;
  91.     procedure ShowRoi;
  92.     procedure SetupUndo;
  93.     procedure SetupUndoFromClip;
  94.     procedure GetLoi (var x1, y1, x2, y2: extended);
  95.     function NotRectangular: boolean;
  96.     function NotInBounds: boolean;
  97.     function NoSelection: boolean;
  98.     function NoUndo: boolean;
  99.     procedure CloneInfo (var OldInfo, NewInfo: PicInfo);
  100.     function NewPicWindow (name: str255; width, height: integer): boolean;
  101.     function GetAngle (dx, dy: extended):extended;
  102.     procedure MakeRegion;
  103.     procedure SelectAll (visible: boolean);
  104.     procedure EraseScreen;
  105.     procedure RestoreScreen;
  106.     procedure UpdateTitleBar;
  107.     procedure Unzoom;
  108.     procedure DrawBString (str: string);
  109.     procedure DrawMyGrowIcon (w: WindowPtr);
  110.     procedure PutMemoryAlert;
  111.     function GetBigHandle (NeededSize: LongInt): handle;
  112.     function GetImageMemory (SaveInfo: infoPtr): ptr;
  113.     procedure UpdateAnalysisMenu;
  114.     procedure ExtendWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
  115.     procedure MakeNewWindow (name: str255);
  116.     function long2str (num: LongInt): str255;
  117.     procedure PutWarning;
  118.     procedure ScaleToFit;
  119.     procedure SetupRoiRect;
  120.     procedure SetForegroundColor (color: integer);
  121.     procedure SetBackgroundColor (color: integer);
  122.     procedure GetForegroundColor (event: EventRecord);
  123.     procedure GetBackgroundColor (event: EventRecord);
  124.     procedure GenerateValues;
  125.     procedure KillOperation;
  126.     procedure ScaleImageWindow (var trect: rect);
  127.     procedure InvertGrayLevels;
  128.     function TooWide: boolean;
  129.     procedure DrawTextString (str: str255; loc: point; just: integer);
  130.     procedure IncrementCounter;
  131.     procedure ClearResults (i: integer);
  132.     procedure UpdateFitEllipse;
  133.     procedure UpdateTextItems;
  134.     procedure MakeLowerCase (var str: str255);
  135.     function PutMessageWithCancel (str: str255): integer;
  136.     function CurrentWindow: integer;
  137.     procedure FindMonitors (NewScreenDepth: integer);
  138.     function ScreenDepth: integer;
  139.     procedure SetFColor (index: integer);
  140.     procedure SetBColor (index: integer);
  141.     function DoubleToReal(d:FakeDouble):extended; {68k-bug}
  142.     procedure RealToDouble(rr: extended; var d:FakeDouble);
  143.     function MakeStackFromWindow: boolean;
  144.     procedure SelectSlice (i: integer);
  145.     procedure UpdateWindowsMenuItem;
  146.     function AddSlice (update: boolean): boolean;
  147.     procedure AbortMacro;
  148.     procedure TruncateString(var str: str255; length: integer);
  149.     procedure RemovePath(var str: str255);
  150.     procedure CloseVdig;
  151.     
  152.  
  153. implementation
  154.  
  155.  
  156.     type
  157.         KeyPtrType = ^KeyMap;
  158.  
  159.  
  160.  
  161.     {procedure MacsBug (str: str255);
  162.     inline
  163.         $abff;}
  164.  
  165.  
  166.     procedure ShowMessage (str: str255);
  167.         var
  168.             vloc, hloc: integer;
  169.             tPort: GrafPtr;
  170.             trect: rect;
  171.             SaveGDevice: GDHandle;
  172.     begin
  173.         SaveGDevice := GetGDevice;
  174.         SetGDevice(GetMainDevice);
  175.       InfoMessage := str;
  176.         GetPort(tPort);
  177.         vloc := 35;
  178.         hloc := 4;
  179.         SetPort(InfoWindow);
  180.         TextFont(Geneva);
  181.         TextSize(9);
  182.         Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight);
  183.         TETextBox(pointer(ord(@InfoMessage) + 1), length(InfoMessage), trect, teJustLeft);
  184.         SetPort(tPort);
  185.         SetGDevice(SaveGDevice);
  186.         wait(120);
  187.     end;
  188.  
  189.  
  190.     procedure SetDlogItem (TheDialog: DialogPtr; item, value: integer);
  191.         var
  192.             ItemType: integer;
  193.             ItemBox: rect;
  194.             ItemHdl: handle;
  195.     begin
  196.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  197.         SetControlValue(ControlHandle(ItemHdl),value)
  198.     end;
  199.  
  200.  
  201.     procedure OutlineButton (theDialog: DialogPtr; itemNo, CornerRad: integer);
  202.   {Draws a border around a button. 16 is the normal}
  203.   {corner radius for small buttons }
  204.         var
  205.             itemType: Integer;
  206.             itemBox: Rect;
  207.             itemHdl: Handle;
  208.             tempPort: GrafPtr;
  209.     begin
  210.         GetPort(tempPort);
  211.         SetPort(GrafPtr(theDialog));
  212.         GetDialogItem(theDialog, itemNo, itemType, itemHdl, itemBox);
  213.         PenSize(3, 3);
  214.         InSetRect(itemBox, -4, -4);
  215.         FrameRoundRect(itemBox, cornerRad, cornerRad);
  216.         PenSize(1, 1);
  217.         SetPort(tempPort);
  218.     end;
  219.  
  220.  
  221.     function GetDNum (TheDialog: DialogPtr; item: integer): LongInt;
  222.         var
  223.             ItemType: integer;
  224.             ItemBox: rect;
  225.             ItemHdl: handle;
  226.             str: str255;
  227.             n: LongInt;
  228.     begin
  229.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  230.         GetDialogItemText(ItemHdl, str);
  231.         StringToNum(str, n);
  232.         GetDNum := n;
  233.     end;
  234.  
  235.  
  236.     function GetDString (TheDialog: DialogPtr; item: integer): str255;
  237.         var
  238.             ItemType: integer;
  239.             ItemBox: rect;
  240.             ItemHdl: handle;
  241.             str: str255;
  242.     begin
  243.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  244.         GetDialogItemText(ItemHdl, str);
  245.         GetDString := str;
  246.     end;
  247.  
  248.  
  249.     procedure SetDNum (TheDialog: DialogPtr; item: integer; n: LongInt);
  250.         var
  251.             ItemType: integer;
  252.             ItemBox: rect;
  253.             ItemHdl: handle;
  254.             str: str255;
  255.     begin
  256.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  257.         NumToString(n, str);
  258.         SetDialogItemText(ItemHdl, str)
  259.     end;
  260.  
  261.  
  262.     procedure GetWindowRect (w: WindowPtr; var wrect: rect);
  263.   {Returns global coordinates of specified window.}
  264.     begin
  265.         if w <> nil then
  266.             wrect := WindowPeek(w)^.contRgn^^.rgnBBox
  267.         else
  268.             SetRect(wrect, 0, 0, 0, 0);
  269.     end;
  270.  
  271.  
  272.     procedure SetDReal (TheDialog: DialogPtr; item: integer; n: extended; fwidth: integer);
  273.         var
  274.             ItemType: integer;
  275.             ItemBox: rect;
  276.             ItemHdl: handle;
  277.             str: str255;
  278.     begin
  279.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  280.         RealToString(n, 1, fwidth, str);
  281.         SetDialogItemText(ItemHdl, str)
  282.     end;
  283.  
  284.     procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
  285.         var
  286.             ItemType: integer;
  287.             ItemBox: rect;
  288.             ItemHdl: handle;
  289.     begin
  290.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  291.         SetDialogItemText(ItemHdl, str)
  292.     end;
  293.  
  294.  
  295.     function GetDReal (TheDialog: DialogPtr; item: integer): extended;
  296.         var
  297.             str: str255;
  298.     begin
  299.         str := GetDString(TheDialog, item);
  300.         GetDReal := StringToReal(str);
  301.     end;
  302.  
  303.  
  304.     procedure DrawLong (i: LongInt);
  305.         var
  306.             str: str255;
  307.     begin
  308.         NumToString(i, str);
  309.         DrawString(str);
  310.     end;
  311.  
  312.  
  313.     procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
  314.   {Does number to string conversion equivalent to write(val:width:fwidth).}
  315.   var
  316.       i:integer;
  317.     begin
  318.         if width<1 then width:=1;
  319.         if (fwidth<0) or (fwidth>8) then fwidth:=0;
  320.         str:=StringOf(val:width:fwidth);
  321.     end;
  322.  
  323.  
  324.     procedure DrawReal (Val: extended; width, fwidth: integer);
  325.   {Displays a real(or integer) number at the current location in}
  326.   {a form equivalent to write(val:width:fwidth) }
  327.         var
  328.             str: str255;
  329.     begin
  330.         RealToString(val, width, fwidth, str);
  331.         DrawString(str);
  332.     end;
  333.  
  334.  
  335.     procedure DrawJReal (hloc, vloc: integer; val: extended; fwidth: integer);
  336.   {Draws right justified real number.}
  337.         var
  338.             str: str255;
  339.     begin
  340.         if (val >= 1000.0) or (val <= -1000.0) then
  341.             fwidth := 0;
  342.         RealToString(val, 1, fwidth, str);
  343.         MoveTo(hloc - StringWidth(str) - 2, vloc);
  344.         DrawString(str);
  345.     end;
  346.  
  347.  
  348.     function GetInt (message: str255; default: integer; var Canceled: boolean): integer;
  349.         const
  350.             NumberID = 3;
  351.         var
  352.             mylog: DialogPtr;
  353.             item: integer;
  354.             temp: LongInt;
  355.     begin
  356.         ParamText(message, '', '', '');
  357.         mylog := GetNewDialog(3000, nil, pointer(-1));
  358.         SetDNum(MyLog, NumberID, default);
  359.         SelectdialogItemText(MyLog, NumberID, 0, 32767);
  360.         OutlineButton(MyLog, ok, 16);
  361.         repeat
  362.             ModalDialog(nil, item);
  363.         until (item = ok) or (item = cancel);
  364.         if item = ok then begin
  365.                 Canceled := false;
  366.                 temp := GetDNum(MyLog, NumberID);
  367.                 if (temp > -MaxInt) and (temp <= MaxInt) then
  368.                     GetInt := temp
  369.                 else begin
  370.                         beep;
  371.                         GetInt := default
  372.                     end;
  373.             end {item=ok}
  374.         else begin
  375.                 Canceled := true;
  376.                 GetInt := default;
  377.             end;
  378.         DisposeDialog(mylog);
  379.     end;
  380.  
  381.  
  382.     function GetReal (message: str255; default: extended; precision: integer; var Canceled: boolean): extended;
  383.         const
  384.             NumberID = 3;
  385.         var
  386.             mylog: DialogPtr;
  387.             item: integer;
  388.     begin
  389.         InitCursor;
  390.         ParamText(message, '', '', '');
  391.         mylog := GetNewDialog(3000, nil, pointer(-1));
  392.         SetDReal(MyLog, NumberID, default, precision);
  393.         SelectdialogItemText(MyLog, NumberID, 0, 32767);
  394.         OutlineButton(MyLog, ok, 16);
  395.         repeat
  396.             ModalDialog(nil, item);
  397.         until (item = ok) or (item = cancel);
  398.         if item = ok then begin
  399.                 GetReal := GetDReal(MyLog, NumberID);
  400.                 Canceled := false;
  401.             end
  402.         else begin
  403.                 GetReal := default;
  404.                 Canceled := true;
  405.             end;
  406.         DisposeDialog(mylog);
  407.     end;
  408.  
  409.  
  410.     function OptionKeyDown: boolean;
  411.         var
  412.             KeyPtr: KeyPtrType;
  413.             keys: array[0..3] of LongInt;
  414.     begin
  415.         KeyPtr := KeyPtrType(@keys);
  416.         GetKeys(KeyPtr^);
  417.         OptionKeyDown := (BAND(keys[1], 4)) <> 0;
  418.     end;
  419.  
  420.  
  421.     function ShiftKeyDown: boolean;
  422.         var
  423.             KeyPtr: KeyPtrType;
  424.             keys: array[0..3] of LongInt;
  425.     begin
  426.         KeyPtr := KeyPtrType(@keys);
  427.         GetKeys(KeyPtr^);
  428.         ShiftKeyDown := (BAND(keys[1], 1)) <> 0;
  429.     end;
  430.  
  431.  
  432.     function ControlKeyDown: boolean;
  433.         type
  434.             KeyPtrType = ^KeyMap;
  435.         var
  436.             KeyPtr: KeyPtrType;
  437.             keys: array[0..3] of LongInt;
  438.     begin
  439.         KeyPtr := KeyPtrType(@keys);
  440.         GetKeys(KeyPtr^);
  441.         ControlKeyDown := (BAND(keys[1], 8)) <> 0;
  442.     end;
  443.  
  444.  
  445.     function CommandPeriod: boolean;
  446.         type
  447.             KeyPtrType = ^KeyMap;
  448.         var
  449.             KeyPtr: KeyPtrType;
  450.             keys: array[0..3] of LongInt;
  451.     begin
  452.         KeyPtr := KeyPtrType(@keys);
  453.         GetKeys(KeyPtr^);
  454.         CommandPeriod := (BAND(keys[1], $808000)) = $808000;
  455.     end;
  456.  
  457.  
  458.     function SpaceBarDown: boolean;
  459.         var
  460.             KeyPtr: KeyPtrType;
  461.             keys: array[0..3] of LongInt;
  462.     begin
  463.         KeyPtr := KeyPtrType(@keys);
  464.         GetKeys(KeyPtr^);
  465.         SpaceBarDown := (BAND(keys[1], 512)) <> 0;
  466.     end;
  467.  
  468.  
  469.     procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
  470.  {Draw a string item in a dialog box.}
  471.         var
  472.             r: rect;
  473.             iType: integer;
  474.             ignore: handle;
  475.     begin
  476.         GetDialogItem(d, ItemNum, iType, ignore, r);
  477.         TextFont(fontrqst);
  478.         TextSize(sizerqst);
  479.         TETextBox(pointer(ord(@s) + 1), length(s), r, TEJustRight);
  480.     end;
  481.  
  482.  
  483.     procedure SysResume;
  484.     begin
  485.         FlushEvents(EveryEvent, 0);
  486.         ExitToShell;
  487.     end;
  488.  
  489.  
  490.     procedure beep;
  491.     {Sets the current gdevice to the screen because SysBeep flashes
  492.   the menu bar if the sound level is zero and this is reported to sometimes
  493.     cause a crash on older Macs when using an offscreen gdevice.} 
  494.         var
  495.             SaveGDevice: GDHandle;
  496.     begin
  497.         SaveGDevice := GetGDevice;
  498.         SetGDevice(GetMainDevice);
  499.         SysBeep(1);
  500.         SetGDevice(SaveGDevice);
  501.     end;
  502.  
  503.  
  504.     procedure PutMessage (str: str255);
  505.         var
  506.             ignore: integer;
  507.             SaveGDevice: GDHandle;
  508.     begin
  509.         SaveGDevice := GetGDevice;
  510.         SetGDevice(GetMainDevice);
  511.         InitCursor;
  512.         ParamText(str, '', '', '');
  513.         Ignore := Alert(300, nil);
  514.         SetGDevice(SaveGDevice);
  515.     end;
  516.     
  517.  
  518.     procedure PutError (str: str255);
  519.         var
  520.             ignore: integer;
  521.             SaveGDevice: GDHandle;
  522.     begin
  523.         SaveGDevice := GetGDevice;
  524.         SetGDevice(GetMainDevice);
  525.         InitCursor;
  526.         ParamText(str, '', '', '');
  527.         Ignore := Alert(310, nil);
  528.         SetGDevice(SaveGDevice);
  529.     end;
  530.  
  531.  
  532.     function GetFontSize (item: integer): integer;
  533.         var
  534.             TempSize: integer;
  535.             Canceled: boolean;
  536.     begin
  537.         case item of
  538.             1: 
  539.                 GetFontSize := 9;
  540.             2: 
  541.                 GetFontSize := 10;
  542.             3: 
  543.                 GetFontSize := 12;
  544.             4: 
  545.                 GetFontSize := 14;
  546.             5: 
  547.                 GetFontSize := 18;
  548.             6: 
  549.                 GetFontSize := 24;
  550.             7: 
  551.                 GetFontSize := 36;
  552.             8: 
  553.                 GetFontSize := 48;
  554.             9: 
  555.                 GetFontSize := 56;
  556.             10: 
  557.                 GetFontSize := 72;
  558.             12:  begin
  559.                     TempSize := GetInt('Font Size:', CurrentSize, Canceled);
  560.                     if TempSize < 1 then
  561.                         TempSize := 1;
  562.                     if TempSize > 1000 then
  563.                         TempSize := 1000;
  564.                     if not canceled then
  565.                         GetFontSize := TempSize
  566.                     else
  567.                         GetFontSize := CurrentSize;
  568.                 end;
  569.         end;
  570.     end;
  571.  
  572.  
  573.     procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
  574. {Enable or disable menuh's itemnum. }
  575.     begin
  576.         if on then
  577.             EnableItem(menuh, itemnum)
  578.         else
  579.             DisableItem(menuh, itemnum);
  580.         if ItemNum = 0 then
  581.             DrawMenuBar;
  582.     end;
  583.  
  584.  
  585.     procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
  586.         var
  587.             i: integer;
  588.     begin
  589.         for i := fst to lst do
  590.             if i = item then
  591.                 CheckItem(MenuH, i, true)
  592.             else
  593.                 CheckItem(MenuH, i, false);
  594.     end;
  595.  
  596.  
  597.     procedure UpdateTextItems;
  598.         var
  599.             size, i, MenuItem, FontID, item: integer;
  600.             FontName: str255;
  601.             FontFound, FoundIt: boolean;
  602.             str: str255;
  603.     begin
  604.         FontFound := false;
  605.         for item := 1 to NumFontItems do begin
  606.                 GetMenuItemText(FontMenuH, Item, FontName);
  607.                 GetFNum(FontName, FontID);
  608.                 if FontID = CurrentFontID then begin
  609.                         FontFound := true;
  610.                         CheckItem(FontMenuH, Item, True)
  611.                     end
  612.                 else
  613.                     CheckItem(FontMenuH, Item, false);
  614.             end;
  615.         if not FontFound then begin
  616.                 FoundIt := False;
  617.                 Item := 1;
  618.                 repeat
  619.                     GetMenuItemText(FontMenuH, Item, FontName);
  620.                     GetFNum(FontName, FontID);
  621.                     if FontID = Geneva then begin
  622.                             CheckItem(FontMenuH, Item, True);
  623.                             CurrentFontID := FontID;
  624.                             FoundIt := true;
  625.                         end;
  626.                     Item := Item + 1;
  627.                 until (Item > NumFontItems) or FoundIt;
  628.             end;
  629.  
  630.         for i := 1 to 10 do begin
  631.                 size := GetFontSize(i);
  632.                 if RealFont(CurrentFontID, size) then
  633.                     SetItemStyle(SizeMenuH, i, [outline])
  634.                 else
  635.                     SetItemStyle(SizeMenuH, i, [])
  636.             end;
  637.         NumToString(CurrentSize, str);
  638.         str := concat('Other[', str, ']…');
  639.         SetMenuItemText(SizeMenuH, 12, str);
  640.  
  641.         for i := TxPlain to TxShadow do
  642.             CheckItem(StyleMenuH, i, false);
  643.         if CurrentStyle = [] then
  644.             CheckItem(StyleMenuH, TxPlain, true)
  645.         else begin
  646.                 if Bold in CurrentStyle then
  647.                     CheckItem(StyleMenuH, TxBold, true);
  648.                 if Italic in CurrentStyle then
  649.                     CheckItem(StyleMenuH, TxItalic, true);
  650.                 if Underline in CurrentStyle then
  651.                     CheckItem(StyleMenuH, TxUnderline, true);
  652.                 if Outline in CurrentStyle then
  653.                     CheckItem(StyleMenuH, TxOutline, true);
  654.                 if Shadow in CurrentStyle then
  655.                     CheckItem(StyleMenuH, Txshadow, true);
  656.             end;
  657.  
  658.         case CurrentSize of
  659.             9: 
  660.                 MenuItem := 1;
  661.             10: 
  662.                 MenuItem := 2;
  663.             12: 
  664.                 MenuItem := 3;
  665.             14: 
  666.                 MenuItem := 4;
  667.             18: 
  668.                 MenuItem := 5;
  669.             24: 
  670.                 MenuItem := 6;
  671.             36: 
  672.                 MenuItem := 7;
  673.             48: 
  674.                 MenuItem := 8;
  675.             56: 
  676.                 MenuItem := 9;
  677.             72: 
  678.                 MenuItem := 10;
  679.             otherwise
  680.                 MenuItem := 12;
  681.         end;
  682.         CheckOnOffItem(SizeMenuH, MenuItem, 1, 12);
  683.  
  684.         case TextJust of
  685.             teJustLeft: 
  686.                 MenuItem := LeftItem;
  687.             teJustCenter: 
  688.                 MenuItem := CenterItem;
  689.             teJustRight: 
  690.                 MenuItem := RightItem;
  691.         end;
  692.         CheckOnOffItem(StyleMenuH, MenuItem, LeftItem, RightItem);
  693.  
  694.         if TextBack = NoBack then
  695.             MenuItem := NoBackgroundItem
  696.         else
  697.             MenuItem := WithBackgroundItem;
  698.         CheckOnOffItem(StyleMenuH, MenuItem, NoBackgroundItem, WithBackgroundItem);
  699.     end;
  700.  
  701.  
  702.     procedure LoadLUT (table: MyCSpecArray);
  703.         var
  704.             i, entry, screen: integer;
  705.             cPtr: ^cSpecArray;
  706.             SaveDevice: GDHandle;
  707.     begin
  708.         if nExtraColors > 0 then begin
  709.                 entry := FirstExtraColorsEntry;
  710.                 for i := 1 to nExtraColors do begin
  711.                         table[entry].rgb := ExtraColors[i];
  712.                         entry := entry + 1;
  713.                     end;
  714.             end;
  715.         if HighLightMode then begin
  716.                 table[1].rgb := Highlight1;
  717.                 table[254].rgb := Highlight254;
  718.             end;
  719.         for i := 1 to 254 do {Work around needed for 32-bit QuickDraw}
  720.             with table[i].rgb do
  721.                 if (red = 0) and (green = 0) and (blue = 0) then begin
  722.                         red := 256;
  723.                         green := 256;
  724.                         blue := 256;
  725.                     end;
  726.         cPtr := @table[1];
  727.         if ScreenDepth = 8 then begin
  728.             SaveDevice := GetGDevice;
  729.             for screen := 1 to nMonitors do begin
  730.                     SetGDevice(Monitors[screen]);
  731.                     for i := 1 to 254 do begin
  732.                             ProtectEntry(i, false);
  733.                             ReserveEntry(i, false);
  734.                         end;
  735.                     SetEntries(1, 253, cPtr^);
  736.                 end;
  737.             SetGDevice(SaveDevice);
  738.         end;
  739.         table[0].rgb := WhiteRGB;
  740.         table[255].rgb := BlackRGB;
  741.         BlockMove(@table, @osGDevice^^.gdPMap^^.pmTable^^.ctTable, SizeOf(table));
  742.         with osGDevice^^.gdPMap^^.pmTable^^ do
  743.             if ScreenDepth = 8 then
  744.                 ctSeed := ScreenPixMap^^.pmTable^^.ctSeed
  745.             else
  746.                 ctSeed := GetCtSeed;
  747.     end;
  748.  
  749.  
  750.     procedure SetupLutUndo;
  751.     begin
  752.         with info^ do begin
  753.                 UndoInfo^.RedLut := RedLut;
  754.                 UndoInfo^.GreenLut := GreenLut;
  755.                 UndoInfo^.BlueLut := BlueLut;
  756.                 UndoInfo^.nColors := nColors;
  757.                 UndoInfo^.ColorStart := ColorStart;
  758.                 UndoInfo^.ColorEnd := ColorEnd;
  759.                 UndoInfo^.FillColor1 := FillColor1;
  760.                 UndoInfo^.FillColor2 := FillColor2;
  761.                 UndoInfo^.LutMode := LutMode;
  762.                 UndoInfo^.ColorTable := ColorTable;
  763.                 UndoInfo^.IdentityFunction := IdentityFunction;
  764.                 UndoInfo^.cTable := cTable;
  765.                 WhatToUndo := UndoLUT;
  766.             end;
  767.     end;
  768.  
  769.  
  770.     procedure UndoLutChange;
  771.     begin
  772.         with info^ do begin
  773.                 RedLut := UndoInfo^.RedLut;
  774.                 GreenLut := UndoInfo^.GreenLut;
  775.                 BlueLut := UndoInfo^.BlueLut;
  776.                 nColors := UndoInfo^.nColors;
  777.                 ColorStart := UndoInfo^.ColorStart;
  778.                 ColorEnd := UndoInfo^.ColorEnd;
  779.                 FillColor1 := UndoInfo^.FillColor1;
  780.                 FillColor2 := UndoInfo^.FillColor2;
  781.                 LutMode := UndoInfo^.LutMode;
  782.                 LutMode := UndoInfo^.LutMode;
  783.                 ColorTable := UndoInfo^.ColorTable;
  784.                 cTable := UndoInfo^.cTable;
  785.                 LoadLut(cTable);
  786.                 Thresholding := false;
  787.                 WhatToUndo := NothingToUndo;
  788.             end;
  789.     end;
  790.  
  791.  
  792.     procedure UpdatePicWindow;
  793.         var
  794.             tPort: GrafPtr;
  795.             SaveGDevice: GDHandle;
  796.     begin
  797.         if (info <> NoInfo) and (info^.wptr <> nil) then
  798.             with Info^ do begin
  799.                     SaveGDevice := GetGDevice;
  800.                     SetGDevice(GetMainDevice);
  801.                     getPort(tPort);
  802.                     SetPort(wptr);
  803.                     SetFColor(BlackIndex);
  804.                     SetBColor(WhiteIndex);
  805.                     CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, nil);
  806.                     SetPort(tPort);
  807.                     SetGDevice(SaveGDevice);
  808.                     RoiUpdateTime := 0;
  809.                 end;
  810.     end;
  811.  
  812.  
  813.     procedure DisableDensitySlice;
  814.         var
  815.             tPort: GrafPtr;
  816.     begin
  817.         if DensitySlicing then begin
  818.                 DensitySlicing := false;
  819.                 UndoLutChange;
  820.                 if ScreenDepth <> 8 then begin
  821.                         UpdatePicWindow;
  822.                         GetPort(tPort);
  823.                         SetPort(LUTWindow);
  824.                         InvalRect(LutWindow^.PortRect);
  825.                         SetPort(tPort);
  826.                     end;
  827.             end;
  828.     end;
  829.  
  830.  
  831.     procedure LoadInputLUT (address: ptr);
  832.         type
  833.             ilutType = packed array[0..1023] of byte;
  834.             ilutPtr = ^ilutType;
  835.         var
  836.             ilut: ilutPtr;
  837.             i: integer;
  838.     begin
  839.         ilut := ilutPtr(address);
  840.         if InvertVideo then begin
  841.                 for i := 0 to 255 do
  842.                     ilut^[i * 4] := i;
  843.                 ilut^[0] := 1;
  844.                 ilut^[255 * 4] := 254
  845.             end
  846.         else begin
  847.                 for i := 0 to 255 do
  848.                     ilut^[i * 4] := 255 - i;
  849.                 ilut^[0] := 254;
  850.                 ilut^[255 * 4] := 1
  851.             end;
  852.     end;
  853.  
  854.  
  855.     procedure ResetQuickCapture;
  856.         const
  857.             ilutOffset = $90000;
  858.     begin
  859.         ControlReg^ := 1; {reset}
  860.         while BitAnd(ControlReg^, $80) = $80 do
  861.             ;
  862.         ChannelReg^ := VideoChannel * 64;
  863.         while BitAnd(ControlReg^, $80) = $80 do
  864.             ;
  865.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  866.     end;
  867.  
  868.  
  869.     procedure ResetScionLG3;
  870.         const
  871.             ilutOffset = $80000;
  872.         var
  873.             SyncChannel, t: integer;
  874.     begin
  875.         ControlReg^ := 0;
  876.         BufferReg^ := 0;
  877.         if SyncMode = SeparateSync then
  878.             SyncChannel := 3
  879.         else
  880.             SyncChannel := VideoChannel;
  881.         t := band(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
  882.         ChannelReg^ := bor(LG3DataOut, bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
  883.         DacHighReg^ := DacHigh;
  884.         DacLowReg^ := DacLow;
  885.         DacAReg^ := LG3DacA;
  886.         DacBReg^ := LG3DacB;
  887.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  888.     end;
  889.  
  890.  
  891.     procedure ResetScionAG5;
  892.         const
  893.             ilutOffset = $E0000;
  894.         var
  895.             SyncChannel: integer;
  896.     begin
  897.         ControlReg^ := 0;
  898.         if SyncMode = SeparateSync then
  899.             SyncChannel := 3
  900.         else
  901.             SyncChannel := VideoChannel;
  902.         ChannelReg^ := bor(ord(AG5BufferMode), bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
  903.         DacHighReg^ := DacHigh;
  904.         DacLowReg^ := DacLow;
  905.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  906.     end;
  907.  
  908.  
  909.     procedure ResetScionVG5f;
  910.         const
  911.             ilutOffset = $80000;
  912.         var
  913.             SyncChannel, t: integer;
  914.     begin
  915.         ControlReg^ := 0;
  916.         if SyncMode = SeparateSync then
  917.             SyncChannel := 3
  918.         else
  919.             SyncChannel := VideoChannel;
  920.         t := band(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
  921.         ChannelReg^ := bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
  922.         DacHighReg^ := DacHigh;
  923.         DacLowReg^ := DacLow;
  924.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  925.     end;
  926.  
  927.  
  928.     procedure ResetFrameGrabber;
  929.     begin
  930.         case FrameGrabber of
  931.             QuickCapture: 
  932.                 ResetQuickCapture;
  933.             ScionLG3: 
  934.                 ResetScionLG3;
  935.             ScionAG5: 
  936.                 ResetScionAG5;
  937.             ScionVG5f:
  938.                 ResetScionVG5f;
  939.             otherwise
  940.                 ;
  941.         end;
  942.     end;
  943.  
  944.  
  945.     procedure CopyOffscreen (src, dst: PixMapHandle; sRect, dRect: rect);
  946.         var
  947.             SaveGDevice: GDHandle;
  948.     begin
  949.         SaveGDevice := GetGDevice;
  950.         SetGDevice(osGDevice);
  951.         pmForeColor(BlackIndex);
  952.         pmBackColor(WhiteIndex);
  953.         CopyBits(BitMapHandle(fgPixMap)^^, BitMapHandle(dst)^^, sRect, dRect, DitherCopy, nil);
  954.         pmForeColor(ForegroundIndex);
  955.         pmBackColor(BackgroundIndex);
  956.         SetGDevice(SaveGDevice);
  957.     end;
  958.  
  959.  
  960.     procedure wait (ticks: LongInt);
  961.         var
  962.             SaveTicks: LongInt;
  963.     begin
  964.         SaveTicks := TickCount + ticks;
  965.         repeat
  966.         until TickCount > SaveTicks;
  967.     end;
  968.  
  969.  
  970.     function GetScrapCount: integer;
  971.         var
  972.             ScrapInfo: ScrapStuffPtr;
  973.     begin
  974.         ScrapInfo := InfoScrap;
  975.         GetScrapCount := ScrapInfo^.ScrapCount;
  976.     end;
  977.  
  978.  
  979.     procedure DisplayText (update: boolean);
  980.         var
  981.             tPort: GrafPtr;
  982.             i, hstart, width, ff: integer;
  983.             MaskRect: rect;
  984.             p1, p2: point;
  985.             SaveGDevice: GDHandle;
  986.     begin
  987.         if (info = NoInfo) or (not IsInsertionPoint) then
  988.             exit(DisplayText);
  989.         if update then
  990.             Undo;
  991.         SaveGDevice := GetGDevice;
  992.         SetGDevice(osGDevice);
  993.         GetPort(tPort);
  994.         SetPort(GrafPtr(Info^.osPort));
  995.         pmForeColor(ForegroundIndex);
  996.         pmBackColor(BackgroundIndex);
  997.         TextFont(CurrentFontID);
  998.         TextFace(CurrentStyle);
  999.         TextSize(CurrentSize);
  1000.         if TextBack = NoBack then
  1001.             TextMode(SrcOr)
  1002.         else
  1003.             TextMode(SrcCopy);
  1004.         width := StringWidth(TextStr);
  1005.         case TextJust of
  1006.             teJustLeft: 
  1007.                 hstart := TextStart.h;
  1008.             teJustCenter: 
  1009.                 hstart := TextStart.h - width div 2;
  1010.             teJustRight: 
  1011.                 hstart := TextStart.h - width;
  1012.         end;
  1013.         if hstart < 0 then
  1014.             hstart := 0;
  1015.         MoveTo(hstart, TextStart.v);
  1016.         DrawString(TextStr);
  1017.         GetPen(InsertionPoint);
  1018.         ff := CurrentSize * 2;
  1019.         p1.h := hstart - ff;
  1020.         p1.v := TextStart.v - CurrentSize;
  1021.         p2.h := TextStart.h + width + ff;
  1022.         p2.v := TextStart.v + CurrentSize div 3;
  1023.         Pt2Rect(p1, p2, MaskRect);
  1024.         UpdateScreen(MaskRect);
  1025.         SetPort(tPort);
  1026.         SetGDevice(SaveGDevice);
  1027.         Info^.changes := true;
  1028.     end;
  1029.  
  1030.  
  1031.     procedure OffScreenToScreenRect (var r: rect);
  1032.         var
  1033.             p1, p2: point;
  1034.     begin
  1035.         with r do begin
  1036.                 p1.h := left;
  1037.                 p1.v := top;
  1038.                 p2.h := right;
  1039.                 p2.v := bottom;
  1040.                 OffScreenToScreen(p1);
  1041.                 OffScreenToScreen(p2);
  1042.                 Pt2Rect(p1, p2, r);
  1043.             end;
  1044.     end;
  1045.  
  1046.  
  1047.     procedure ScreenToOffscreen (var loc: point);
  1048.     begin
  1049.         with loc, Info^ do begin
  1050.                 h := SrcRect.left + trunc(h / magnification);
  1051.                 v := SrcRect.top + trunc(v / magnification);
  1052.             end;
  1053.     end;
  1054.  
  1055.  
  1056.     procedure OffscreenToScreen (var loc: point);
  1057.     begin
  1058.         with loc, Info^ do begin
  1059.                 h := trunc((h - SrcRect.left) * magnification);
  1060.                 v := trunc((v - SrcRect.top) * magnification);
  1061.             end;
  1062.     end;
  1063.  
  1064.  
  1065.  
  1066.     procedure UpdateScreen (MaskRect: rect);
  1067.  {Refreshes the portion of the screen defined by}
  1068.   {MaskRect, where MaskRect is defined in offscreen coordinates.}
  1069.         var
  1070.             tPort: GrafPtr;
  1071.             imag: integer;
  1072.             SaveGDevice: GDHandle;
  1073.     begin
  1074.         OffScreenToScreenRect(MaskRect);
  1075.         with Info^ do
  1076.             if info <> NoInfo then begin
  1077.                     SaveGDevice := GetGDevice;
  1078.                     SetGDevice(GetMainDevice);
  1079.                     getPort(tPort);
  1080.                     SetPort(wptr);
  1081.                     SetFColor(BlackIndex);
  1082.                     SetBColor(WhiteIndex);
  1083.                     imag := trunc(magnification);
  1084.                     InsetRect(MaskRect, -imag * 2 * LineWidth, -imag * 2 * LineWidth);
  1085.                     InsetRect(MaskRect, 0, 0);
  1086.                     RectRgn(MaskRgn, MaskRect);
  1087.                     CopyBits(BitMapHandle(osPort^.PortPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, MaskRgn);
  1088.                     SetPort(tPort);
  1089.                     SetGDevice(SaveGDevice);
  1090.                 end;
  1091.     end;
  1092.  
  1093.  
  1094.     procedure RestoreRoi;
  1095.     begin
  1096.         with Info^ do begin
  1097.                 SetupUndo;
  1098.                 if RoiShowing then
  1099.                     UpdateScreen(RoiRect);
  1100.                 roiType := NoInfo^.roiType;
  1101.                 RoiRect := NoInfo^.RoiRect;
  1102.                 CopyRgn(NoInfo^.roiRgn, roiRgn);
  1103.                 LX1 := NoInfo^.LX1;
  1104.                 LY1 := NoInfo^.LY1;
  1105.                 LX2 := NoInfo^.LX2;
  1106.                 LY2 := NoInfo^.LY2;
  1107.                 LAngle := NoInfo^.LAngle;
  1108.                 RoiShowing := true;
  1109.                 measuring := false;
  1110.             end;
  1111.     end;
  1112.  
  1113.  
  1114.     procedure Undo;
  1115.         var
  1116.             SrcPtr: ptr;
  1117.             line: integer;
  1118.     begin
  1119.         if info^.PixMapSize <> CurrentUndoSize then
  1120.             exit(Undo);
  1121.         if UndoFromClip then begin
  1122.                 if info^.PixMapSize > ClipBufSize then
  1123.                     exit(Undo);
  1124.                 SrcPtr := ClipBuf;
  1125.             end
  1126.         else
  1127.             SrcPtr := UndoBuf;
  1128.         with info^ do
  1129.             BlockMove(SrcPtr, PicBaseAddr, PixMapSize);
  1130.         if UndoFromClip and RestoreUndoBuf then
  1131.             with info^ do
  1132.                 BlockMove(SrcPtr, UndoBuf, PixMapSize);
  1133.         if RedoSelection then
  1134.             RestoreRoi;
  1135.     end;
  1136.  
  1137.  
  1138.     function MyGetPixel (h, v: LongInt): integer;
  1139.     begin
  1140.         MyGetPixel := BackgroundIndex;
  1141.         with Info^ do
  1142.             if h >= 0 then
  1143.                 if v >= 0 then
  1144.                     if h < PixelsPerLine then
  1145.                         if v < nlines then
  1146.                             MyGetPixel := ImageP(PicBaseAddr)^[v * BytesPerRow + h];
  1147.                {MyGetPixel := band(ptr(Ord4(PicBaseAddr) + v * BytesPerRow + h)^, 255);}
  1148.     end;
  1149.  
  1150.  
  1151.     procedure PutPixel (h, v: LongInt; value: integer);
  1152.         var
  1153.             addr: Ptr;
  1154.     begin
  1155.         with Info^ do
  1156.             if h >= 0 then
  1157.                 if v >= 0 then
  1158.                     if h < PixelsPerLine then
  1159.                         if v < nlines then begin
  1160.                                 addr := Ptr(Ord4(PicBaseAddr) + v * BytesPerRow + h);
  1161.                                 addr^ := value;
  1162.                             end;
  1163.     end;
  1164.  
  1165.  
  1166.     procedure GetLine (h, v, count: LongInt; var line: LineType);
  1167.         var
  1168.             offset: LongInt;
  1169.             p: ptr;
  1170.             i: integer;
  1171.     begin
  1172.         if count > MaxLine then
  1173.             count := MaxLine;
  1174.         with Info^ do begin
  1175.                 if (h < 0) or (v < 0) or ((h + count) > PixelsPerLine) or (v >= nlines) then begin
  1176.                         for i := 0 to count - 1 do
  1177.                             line[i] := MyGetPixel(h + i, v);
  1178.                         exit(GetLine);
  1179.                     end;
  1180.                 offset := v * BytesPerRow + h;
  1181.                 p := ptr(ord4(PicBaseAddr) + offset);
  1182.                 BlockMove(p, @line, count);
  1183.             end;
  1184.     end;
  1185.  
  1186.  
  1187.     procedure GetColumn (h, v, count: LongInt; var data: LineType);
  1188.         var
  1189.             col, pic, bpr: LongInt;
  1190.             i: integer;
  1191.     begin
  1192.         if count > MaxLine then
  1193.             count := MaxLine;
  1194.         with Info^ do begin
  1195.                 if (h < 0) or (v < 0) or (h >= PixelsPerLine) or ((v + count) > nlines) then begin
  1196.                         for i := 0 to count - 1 do
  1197.                             data[i] := MyGetPixel(h, v + i);
  1198.                         exit(GetColumn);
  1199.                     end;
  1200.                 col := Ord4(@data);
  1201.                 bpr := BytesPerRow;
  1202.                 pic := Ord4(PicBaseAddr) + v * bpr + h;
  1203.                 while count > 0 do begin
  1204.                         Ptr(col)^ := Ptr(pic)^;
  1205.                         pic := pic + bpr;
  1206.                         col := col + 1;
  1207.                         count := count - 1;
  1208.                     end;
  1209.             end;
  1210.     end;
  1211.  
  1212.  
  1213.     procedure PutColumn (hstart, vstart, count: LongInt; var data: LineType);
  1214.         var
  1215.             col, pic, bpr: LongInt;
  1216.     begin
  1217.         col := Ord4(@data);
  1218.         with Info^ do begin
  1219.                 bpr := BytesPerRow;
  1220.                 if count > 0 then
  1221.                     if hstart >= 0 then
  1222.                         if vstart >= 0 then
  1223.                             if hstart < PixelsPerLine then begin
  1224.                                     if vstart > nlines - count then
  1225.                                         count := nlines - vstart;
  1226.                                     pic := Ord4(PicBaseAddr) + vstart * bpr + hstart;
  1227.                                     while count > 0 do begin
  1228.                                             Ptr(pic)^ := Ptr(col)^;
  1229.                                             pic := pic + bpr;
  1230.                                             col := col + 1;
  1231.                                             count := count - 1;
  1232.                                         end;
  1233.                                 end;
  1234.             end;
  1235.     end;
  1236.  
  1237.  
  1238.     procedure PutLine (h, v, count: LongInt; var line: LineType);
  1239.         var
  1240.             offset: LongInt;
  1241.             p: ptr;
  1242.     begin
  1243.         with Info^ do begin
  1244.                 if (h < 0) or (v < 0) or (v >= nlines) then
  1245.                     exit(PutLine);
  1246.                 if (h + count) > PixelsPerLine then
  1247.                     count := PixelsPerLine - h;
  1248.                 offset := v * BytesPerRow + h;
  1249.                 p := ptr(ord4(PicBaseAddr) + offset);
  1250.                 BlocKMove(@line, p, count);
  1251.             end;
  1252.     end;
  1253.  
  1254.  
  1255.     procedure Show1Value (rvalue, CalibratedValue: extended);
  1256.         var
  1257.             tPort: GrafPtr;
  1258.             hstart, vstart, ivalue: integer;
  1259.     begin
  1260.         hstart := InfoHStart;
  1261.         vstart := InfoVStart;
  1262.         GetPort(tPort);
  1263.         SetPort(InfoWindow);
  1264.         TextSize(9);
  1265.         TextFont(Monaco);
  1266.         TextMode(SrcCopy);
  1267.         MoveTo(xValueLoc, vstart);
  1268.         if CalibratedValue <> NoValue then begin
  1269.                 DrawReal(CalibratedValue, 5, 2);
  1270.                 DrawString(' (');
  1271.                 DrawReal(rvalue, 3, 0);
  1272.                 DrawString(')');
  1273.             end
  1274.         else
  1275.             DrawReal(rvalue, 6, 2);
  1276.         DrawString('    ');
  1277.         SetPort(tPort);
  1278.     end;
  1279.  
  1280.  
  1281.     procedure Show2PlotValues (x, y: extended);
  1282.         var
  1283.             tPort: GrafPtr;
  1284.             hstart, vstart, ivalue: integer;
  1285.     begin
  1286.         with info^ do begin
  1287.                 hstart := InfoHStart;
  1288.                 vstart := InfoVStart;
  1289.                 GetPort(tPort);
  1290.                 SetPort(InfoWindow);
  1291.                 TextSize(9);
  1292.                 TextFont(Monaco);
  1293.                 TextMode(SrcCopy);
  1294.                 MoveTo(xValueLoc, vstart);
  1295.                 DrawXDimension(round(x), 0);
  1296.                 MoveTo(yValueLoc, vstart + 10);
  1297.                 DrawReal(y, 6, 2);
  1298.                 SetPort(tPort);
  1299.             end;
  1300.     end;
  1301.  
  1302.  
  1303.     procedure Show2Values (current, total: LongInt);
  1304.         var
  1305.             tPort: GrafPtr;
  1306.             hstart, vstart, ivalue: integer;
  1307.     begin
  1308.         hstart := InfoHStart;
  1309.         vstart := InfoVStart;
  1310.         GetPort(tPort);
  1311.         SetPort(InfoWindow);
  1312.         TextSize(9);
  1313.         TextFont(Monaco);
  1314.         TextMode(SrcCopy);
  1315.         MoveTo(xValueLoc, vstart);
  1316.         DrawLong(current);
  1317.         DrawString('     ');
  1318.         MoveTo(yValueLoc, vstart + 10);
  1319.         DrawLong(total);
  1320.         DrawString('     ');
  1321.         SetPort(tPort);
  1322.     end;
  1323.  
  1324.  
  1325.     procedure DrawXDimension (x: extended; digits: integer);
  1326.     begin
  1327.         with info^ do begin
  1328.                 if SpatiallyCalibrated then begin
  1329.                         DrawReal(x / xScale, 5, 2);
  1330.                         DrawChar(xUnit[1]);
  1331.                         DrawChar(xUnit[2]);
  1332.                         DrawString(' (');
  1333.                         DrawReal(x, 3, digits);
  1334.                         DrawString(')')
  1335.                     end
  1336.                 else
  1337.                     DrawReal(x, 1, digits);
  1338.                 DrawString('      ');
  1339.             end;
  1340.     end;
  1341.  
  1342.  
  1343.     procedure DrawYDimension (y: extended; digits: integer);
  1344.     begin
  1345.         with info^ do begin
  1346.                 if SpatiallyCalibrated then begin
  1347.                         DrawReal(y / yScale, 5, 2);
  1348.                         DrawChar(xUnit[1]);
  1349.                         DrawChar(xUnit[2]);
  1350.                         DrawString(' (');
  1351.                         DrawReal(y, 3, digits);
  1352.                         DrawString(')')
  1353.                     end
  1354.                 else
  1355.                     DrawReal(y, 1, digits);
  1356.                 DrawString('      ');
  1357.             end;
  1358.     end;
  1359.  
  1360.  
  1361.     procedure DrawRGB (index: integer);
  1362.         var
  1363.             rStr, gStr, bStr: str255;
  1364.             TempRGB: rgbColor;
  1365.             i, entry: integer;
  1366.  
  1367.         procedure Convert (n: integer; var str: str255);
  1368.             var
  1369.                 i: integer;
  1370.         begin
  1371.             RealToString(n, 3, 0, str);
  1372.             for i := 1 to 3 do
  1373.                 if str[i] = ' ' then
  1374.                     str[i] := '0';
  1375.         end;
  1376.  
  1377.     begin
  1378.         TempRGB := cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb;
  1379.         with TempRGB do begin
  1380.                 Convert(band(bsr(red, 8), 255), rStr);
  1381.                 Convert(band(bsr(green, 8), 255), gStr);
  1382.                 Convert(band(bsr(blue, 8), 255), bStr);
  1383.                 DrawString(concat(rStr, ' ', gStr, ' ', bStr));
  1384.             end;
  1385.     end;
  1386.  
  1387.  
  1388.     procedure Show3Values (hloc, vloc, ivalue: LongInt);
  1389.         var
  1390.             tPort: GrafPtr;
  1391.             hstart, vstart: integer;
  1392.     begin
  1393.         with info^ do begin
  1394.                 hstart := InfoHStart;
  1395.                 vstart := InfoVStart;
  1396.                 GetPort(tPort);
  1397.                 SetPort(InfoWindow);
  1398.                 TextSize(9);
  1399.                 TextFont(Monaco);
  1400.                 TextMode(SrcCopy);
  1401.                 if hloc < 0 then
  1402.                     hloc := -hloc;
  1403.                 MoveTo(xValueLoc, vstart);
  1404.                 DrawXDimension(hloc, 0);
  1405.                 if InvertYCoordinates and (ivalue >= 0) then
  1406.                     vloc := PicRect.bottom - vloc - 1;
  1407.                 if vloc < 0 then
  1408.                     vloc := -vloc;
  1409.                 MoveTo(yValueLoc, vstart + 10);
  1410.                 DrawYDimension(vloc, 0);
  1411.                 DrawString('    ');
  1412.                 if ivalue >= 0 then begin
  1413.                         MoveTo(zValueLoc, vstart + 20);
  1414.                         if (fit <> uncalibrated) or (CurrentTool = PickerTool) then begin
  1415.                                 if CurrentTool = PickerTool then
  1416.                                     DrawRGB(ivalue)
  1417.                                 else
  1418.                                     DrawReal(cvalue[ivalue], 5, precision);
  1419.                                 DrawString(' (');
  1420.                                 DrawLong(ivalue);
  1421.                                 DrawString(')');
  1422.                             end
  1423.                         else
  1424.                             DrawLong(ivalue);
  1425.                     end;
  1426.                 DrawString('    ');
  1427.                 SetPort(tPort);
  1428.             end;
  1429.     end;
  1430.  
  1431.  
  1432.     procedure ShowDxDy (X, Y: extended);
  1433.         var
  1434.             tPort: GrafPtr;
  1435.             hstart, vstart, ivalue: integer;
  1436.     begin
  1437.         with info^ do begin
  1438.                 hstart := InfoHStart;
  1439.                 vstart := InfoVStart;
  1440.                 GetPort(tPort);
  1441.                 SetPort(InfoWindow);
  1442.                 TextSize(9);
  1443.                 TextFont(Monaco);
  1444.                 TextMode(SrcCopy);
  1445.                 MoveTo(xValueLoc, vstart);
  1446.                 DrawXDimension(x, 2);
  1447.                 MoveTo(yValueLoc, vstart + 10);
  1448.                 DrawYDimension(y, 2);
  1449.                 MoveTo(zValueLoc, vstart + 20);
  1450.                 if SpatiallyCalibrated then begin
  1451.                         DrawReal(sqrt(sqr(x / xScale) + sqr(y / yScale)), 5, 2);
  1452.                         DrawChar(xUnit[1]);
  1453.                         DrawChar(xUnit[2]);
  1454.                         DrawString(' (');
  1455.                         DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
  1456.                         DrawString(')')
  1457.                     end
  1458.                 else
  1459.                     DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
  1460.                 DrawString('    ');
  1461.                 SetPort(tPort);
  1462.             end;
  1463.     end;
  1464.  
  1465.  
  1466.     procedure PutChar (c: char);
  1467.     begin
  1468.         if TextBufSize < MaxTextBufSize then begin
  1469.                 TextBufSize := TextBufSize + 1;
  1470.                 TextBufP^[TextBufSize] := c;
  1471.                 if c = cr then begin
  1472.                         TextBufColumn := 0;
  1473.                         TextBufLineCount := TextBufLineCount + 1
  1474.                     end
  1475.                 else
  1476.                     TextBufColumn := TextBufColumn + 1;
  1477.             end;
  1478.     end;
  1479.  
  1480.  
  1481.     procedure PutTab;
  1482.     begin
  1483.         if not printing then
  1484.             PutChar(tab)
  1485.     end;
  1486.  
  1487.  
  1488.     procedure PutString (str: str255);
  1489.         var
  1490.             i: integer;
  1491.     begin
  1492.         for i := 1 to length(str) do begin
  1493.                 if TextBufSize < MaxTextBufSize then
  1494.                     TextBufSize := TextBufSize + 1;
  1495.                 TextBufP^[TextBufSize] := str[i];
  1496.                 TextBufColumn := TextBufColumn + 1;
  1497.             end;
  1498.     end;
  1499.  
  1500.  
  1501.     procedure PutFString (str: str255; FieldWidth: integer);
  1502.         var
  1503.             LeadingSpaces: integer;
  1504.     begin
  1505.         LeadingSpaces := FieldWidth - length(str);
  1506.         if LeadingSpaces > 0 then
  1507.             str := concat(copy('            ', 1, LeadingSpaces), str);
  1508.         PutString(str);
  1509.     end;
  1510.  
  1511.  
  1512.     procedure PutReal (n: extended; width, fwidth: integer);
  1513.         var
  1514.             str: str255;
  1515.     begin
  1516.         RealToString(n, width, fwidth, str);
  1517.         PutString(str);
  1518.     end;
  1519.  
  1520.  
  1521.     procedure PutLong (n: LongInt; FieldWidth: integer);
  1522.         var
  1523.             str: str255;
  1524.             LeadingSpaces: integer;
  1525.     begin
  1526.         NumToString(n, str);
  1527.         LeadingSpaces := FieldWidth - length(str);
  1528.         if LeadingSpaces > 0 then
  1529.             str := concat(copy('            ', 1, LeadingSpaces), str);
  1530.         PutString(str);
  1531.     end;
  1532.  
  1533.  
  1534.     procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
  1535.         var
  1536.             i, column, fwidth: integer;
  1537.             m: MeasurementTypes;
  1538.  
  1539.         procedure PutSequenceNumber;
  1540.         begin
  1541.             PutLong(i, 4);
  1542.             PutChar('.');
  1543.             PutTab;
  1544.         end;
  1545.  
  1546.         procedure PutUnits;
  1547.         begin
  1548.             if info^.SpatiallyCalibrated then begin
  1549.                     PutString('  (');
  1550.                     DrawChar(info^.xUnit[1]);
  1551.                     DrawChar(info^.xUnit[2]);
  1552.                     PutString(')')
  1553.                 end
  1554.             else
  1555.                 PutString('(Pixels)');
  1556.             PutChar(cr);
  1557.             PutChar(cr);
  1558.         end;
  1559.  
  1560.         procedure PutTabDelimeter;
  1561.         begin
  1562.             Column := Column + 1;
  1563.             if Column <> nListColumns then
  1564.                 PutTab;
  1565.         end;
  1566.  
  1567.     begin
  1568.         if mCount < 1 then begin
  1569.                 TextBufSize := 0;
  1570.                 TextBufLineCount := 0;
  1571.                 exit(CopyResultsToBuffer);
  1572.             end;
  1573.         ShowWatch;
  1574.         Headings := Headings or OptionKeyWasDown;
  1575.         TextBufSize := 0;
  1576.         TextBufColumn := 0;
  1577.         TextBufLineCount := 0;
  1578.         nListColumns := 0;
  1579.         for m := AreaM to StdDevM do
  1580.             if m in Measurements then
  1581.                 nListColumns := nListColumns + 1;
  1582.         if (xyLocM in measurements) or (nPoints > 0) then
  1583.             nListColumns := nListColumns + 2;
  1584.         if ModeM in measurements then
  1585.             nListColumns := nListColumns + 1;
  1586.         if (LengthM in measurements) or (nLengths > 0) then
  1587.             nListColumns := nListColumns + 1;
  1588.         if MajorAxisM in measurements then
  1589.             nListColumns := nListColumns + 1;
  1590.         if MinorAxisM in measurements then
  1591.             nListColumns := nListColumns + 1;
  1592.         if (AngleM in measurements) or (nAngles > 0) then
  1593.             nListColumns := nListColumns + 1;
  1594.         if IntDenM in measurements then
  1595.             nListColumns := nListColumns + 2;
  1596.         if MinMaxM in measurements then
  1597.             nListColumns := nListColumns + 2;
  1598.         if User1M in measurements then
  1599.             nListColumns := nListColumns + 1;
  1600.         if User2M in measurements then
  1601.             nListColumns := nListColumns + 1;
  1602.         with info^ do begin
  1603.                 fwidth := FieldWidth;
  1604.                 if Headings and (FirstCount = 1) then begin
  1605.                         PutFString(' ', 5);
  1606.                         PutTabDelimeter;
  1607.                         if AreaM in measurements then begin
  1608.                                 PutFString('Area', fwidth);
  1609.                                 PutTabDelimeter;
  1610.                             end;
  1611.                         if MeanM in measurements then begin
  1612.                                 PutFString('Mean', fwidth);
  1613.                                 PutTabDelimeter;
  1614.                             end;
  1615.                         if StdDevM in measurements then begin
  1616.                                 PutFString('S.D.', fwidth);
  1617.                                 PutTabDelimeter;
  1618.                             end;
  1619.                         if (xyLocM in measurements) or (nPoints > 0) then begin
  1620.                                 PutFString('X', fwidth);
  1621.                                 PutTabDelimeter;
  1622.                                 PutFString('Y', fwidth);
  1623.                                 PutTabDelimeter;
  1624.                             end;
  1625.                         if ModeM in measurements then begin
  1626.                                 PutFString('Mode', fwidth);
  1627.                                 PutTabDelimeter;
  1628.                             end;
  1629.                         if (LengthM in measurements) or (nLengths > 0) then begin
  1630.                                 PutFString('Length', fwidth);
  1631.                                 PutTabDelimeter;
  1632.                             end;
  1633.                         if MajorAxisM in measurements then begin
  1634.                                 PutFString(MajorLabel, fwidth);
  1635.                                 PutTabDelimeter;
  1636.                             end;
  1637.                         if MinorAxisM in measurements then begin
  1638.                                 PutFString(MinorLabel, fwidth);
  1639.                                 PutTabDelimeter;
  1640.                             end;
  1641.                         if (AngleM in measurements) or (nAngles > 0) then begin
  1642.                                 PutFString('Angle', fwidth);
  1643.                                 PutTabDelimeter;
  1644.                             end;
  1645.                         if IntDenM in measurements then begin
  1646.                                 PutFString('Int.Den.', fwidth + 2);
  1647.                                 PutTabDelimeter;
  1648.                                 PutFString('Back.', fwidth);
  1649.                                 PutTabDelimeter;
  1650.                             end;
  1651.                         if MinMaxM in measurements then begin
  1652.                                 PutFString('Min', fwidth);
  1653.                                 PutTabDelimeter;
  1654.                                 PutFString('Max', fwidth);
  1655.                                 PutTabDelimeter;
  1656.                             end;
  1657.                         if User1M in measurements then begin
  1658.                                 PutFString(User1Label, fwidth);
  1659.                                 PutTabDelimeter;
  1660.                             end;
  1661.                         if User2M in measurements then begin
  1662.                                 PutFString(User2Label, fwidth);
  1663.                                 PutTabDelimeter;
  1664.                             end;
  1665.                         PutChar(cr);
  1666.                         PutChar(cr);
  1667.                     end;
  1668.                 for i := FirstCount to LastCount do begin
  1669.                         column := 0;
  1670.                         if Headings then
  1671.                             PutSequenceNumber;
  1672.                         if AreaM in measurements then begin
  1673.                                 PutReal(mArea^[i], fwidth, precision);
  1674.                                 PutTabDelimeter;
  1675.                             end;
  1676.                         if MeanM in measurements then begin
  1677.                                 PutReal(mean^[i], fwidth, precision);
  1678.                                 PutTabDelimeter;
  1679.                             end;
  1680.                         if StdDevM in measurements then begin
  1681.                                 PutReal(sd^[i], fwidth, precision);
  1682.                                 PutTabDelimeter;
  1683.                             end;
  1684.                         if (xyLocM in measurements) or (nPoints > 0) then begin
  1685.                                 PutReal(xcenter^[i], fwidth, precision);
  1686.                                 PutTab;
  1687.                                 PutReal(ycenter^[i], fwidth, precision);
  1688.                                 PutTabDelimeter;
  1689.                             end;
  1690.                         if ModeM in measurements then begin
  1691.                                 PutReal(mode^[i], fwidth, precision);
  1692.                                 PutTabDelimeter;
  1693.                             end;
  1694.                         if (LengthM in measurements) or (nLengths > 0) then begin
  1695.                                 PutReal(plength^[i], fwidth, precision);
  1696.                                 PutTabDelimeter;
  1697.                             end;
  1698.                         if MajorAxisM in measurements then begin
  1699.                                 PutReal(MajorAxis^[i], fwidth, precision);
  1700.                                 PutTabDelimeter;
  1701.                             end;
  1702.                         if MinorAxisM in measurements then begin
  1703.                                 PutReal(MinorAxis^[i], fwidth, precision);
  1704.                                 PutTabDelimeter;
  1705.                             end;
  1706.                         if (AngleM in measurements) or (nAngles > 0) then begin
  1707.                                 PutReal(orientation^[i], fwidth, precision);
  1708.                                 PutTabDelimeter;
  1709.                             end;
  1710.                         if IntDenM in measurements then begin
  1711.                                 PutReal(IntegratedDensity^[i], fwidth + 2, precision);
  1712.                                 PutTabDelimeter;
  1713.                                 PutReal(idBackground^[i], fwidth, precision);
  1714.                                 PutTabDelimeter;
  1715.                             end;
  1716.                         if MinMaxM in measurements then begin
  1717.                                 PutReal(mMin^[i], fwidth, precision);
  1718.                                 PutTabDelimeter;
  1719.                                 PutReal(mMax^[i], fwidth, precision);
  1720.                                 PutTabDelimeter;
  1721.                             end;
  1722.                         if User1M in measurements then begin
  1723.                                 PutReal(User1^[i], fwidth, precision);
  1724.                                 PutTabDelimeter;
  1725.                             end;
  1726.                         if User2M in measurements then begin
  1727.                                 PutReal(User2^[i], fwidth, precision);
  1728.                                 PutTabDelimeter;
  1729.                             end;
  1730.                         PutChar(cr);
  1731.                     end; {for}
  1732.             end; {with}
  1733.     end;
  1734.  
  1735.  
  1736.     procedure ShowWatch;
  1737.     begin
  1738.         SetCursor(watch);
  1739.     end;
  1740.  
  1741.  
  1742.     procedure ShowAnimatedWatch;
  1743.     begin
  1744.         SetCursor(AnimatedWatch[WatchIndex]);
  1745.         WatchIndex := WatchIndex + 1;
  1746.         if WatchIndex > 8 then
  1747.             WatchIndex := 1;
  1748.     end;
  1749.  
  1750.  
  1751.     procedure CaptureImage;
  1752.         var
  1753.             Timeout: LongInt;
  1754.             vdigErr: ComponentResult;
  1755.     begin
  1756.         case FrameGrabber of
  1757.             QuickCapture:  begin
  1758.                     ControlReg^ := BitAnd($80, 255); {Start frame capture}
  1759.                     while BitAnd(ControlReg^, $80) = $80 do
  1760.                         ;       {Wait for it to complete}
  1761.                 end;
  1762.             ScionLG3, ScionAG5, ScionVG5f:  begin
  1763.                     TimeOut := TickCount + 30;  {1/2sec. timeout}
  1764.                     ControlReg^ := $80; {Start frame capture}
  1765.                     while BitAnd(ControlReg^, $80) = $00 do begin    {Wait for it to complete}
  1766.                             if TickCount > TimeOut then begin
  1767.                                     ControlReg^ := $00;
  1768.                                     leave
  1769.                                 end;
  1770.                         end;
  1771.                     ControlReg^ := $00;
  1772.                 end;
  1773.             QTvdig:
  1774.                 if vdig <> nil then
  1775.                     vdigErr := VDGrabOneFrame(vdig);
  1776.         end; {case}
  1777.     end;
  1778.  
  1779.  
  1780.     procedure Paste;
  1781.         var
  1782.             srcPixMap: PixMapHandle;
  1783.             PCILivePaste: boolean;
  1784.     begin
  1785.         if info = NoInfo then begin
  1786.                 beep;
  1787.                 exit(Paste)
  1788.             end;
  1789.         with Info^ do begin
  1790.                 if not RoiShowing then
  1791.                     exit(Paste);
  1792.                 if PasteTransferMode = SrcCopy then begin
  1793.                         pmForeColor(BlackIndex);
  1794.                         pmBackColor(WhiteIndex);
  1795.                     end;
  1796.                 srcPixMap := ClipBufInfo^.osPort^.PortPixMap;
  1797.                 PCILivePaste := false;
  1798.                 if LivePasteMode then
  1799.                     if ((WhatsOnClip = CameraPic) or (WhatsOnClip = LivePic)) and (PictureType <> FrameGrabberType) then begin
  1800.                             if PCIFrameGrabber then
  1801.                                 with fgPort^.PortPixMap^^ do begin
  1802.                                     BaseAddr := ptr(fgSlotBase);
  1803.                                     PCILivePaste := true;
  1804.                                 end;
  1805.                             CaptureImage;
  1806.                             srcPixMap := fgPixMap;
  1807.                         end;
  1808.                 CopyBits(BitMapHandle(srcPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, ClipBufInfo^.RoiRect, RoiRect, PasteTransferMode, roiRgn);
  1809.                 if PCILivePaste then
  1810.                     with fgPort^.PortPixMap^^ do
  1811.                         BaseAddr := ptr(fgSuperSlotBase0);
  1812.                 if PasteTransferMode = SrcCopy then begin
  1813.                         pmForeColor(ForegroundIndex);
  1814.                         pmBackColor(BackgroundIndex);
  1815.                     end;
  1816.             end;
  1817.     end;
  1818.  
  1819.  
  1820.     procedure DoOperation (Operation: OpType);
  1821.         var
  1822.             tPort: GrafPtr;
  1823.             loc: point;
  1824.             width, height, SaveWidth: integer;
  1825.             tRect: rect;
  1826.             SaveGDevice: GDHandle;
  1827.     begin
  1828.         SaveGDevice := GetGDevice;
  1829.         GetPort(tPort);
  1830.         with Info^ do begin
  1831.                 changes := true;
  1832.                 SetGDevice(osGDevice);
  1833.                 SetPort(GrafPtr(osPort));
  1834.                 pmForeColor(ForegroundIndex);
  1835.                 pmBackColor(BackgroundIndex);
  1836.                 PenNormal;
  1837.                 case Operation of
  1838.                     InvertOp: 
  1839.                         InvertRgn(roiRgn);
  1840.                     PaintOp: 
  1841.                         PaintRgn(roiRgn);
  1842.                     FrameOp:  begin
  1843.                             if (RoiType = LineRoi) or (RoiType = FreeLineRoi) or (RoiTYpe = SegLineRoi) then
  1844.                                 PenSize(1, 1)
  1845.                             else
  1846.                                 PenSize(LineWidth, LineWidth);
  1847.                             FrameRgn(roiRgn);
  1848.                         end;
  1849.                     EraseOp:begin 
  1850.                             EraseRgn(roiRgn);
  1851.                         end;
  1852.                     PasteOp: 
  1853.                         Paste;
  1854.                     otherwise
  1855.                 end;
  1856.                 if not RoiShowing then begin
  1857.                     UpdateScreen(RoiRect);
  1858.                     end;
  1859.                 if PixMapSize > UndoBufSize then
  1860.                     OpPending := false;
  1861.             end;
  1862.         SetPort(tPort);
  1863.         SetGDevice(SaveGDevice);
  1864.     end;
  1865.  
  1866.  
  1867.     procedure SaveRoi;
  1868.     begin
  1869.         with info^ do
  1870.             if RoiType <> noRoi then begin
  1871.                     NoInfo^.roiType := roiType;
  1872.                     NoInfo^.RoiRect := RoiRect;
  1873.                     CopyRgn(roiRgn, NoInfo^.roiRgn);
  1874.                     NoInfo^.LX1 := LX1;
  1875.                     NoInfo^.LY1 := LY1;
  1876.                     NoInfo^.LX2 := LX2;
  1877.                     NoInfo^.LY2 := LY2;
  1878.                     NoInfo^.LAngle := LAngle;
  1879.                 end;
  1880.     end;
  1881.  
  1882.  
  1883.     procedure KillRoi;
  1884.         var
  1885.             trect: rect;
  1886.     begin
  1887.         with info^ do begin
  1888.                 if RoiShowing then begin
  1889.                         if OpPending then begin
  1890.                                 OpPending := false;
  1891.                                 DoOperation(CurrentOp);
  1892.                             end;
  1893.                         SaveRoi;
  1894.                         RoiShowing := false;
  1895.                         trect := RoiRect;
  1896.                         if RoiType = LineRoi then
  1897.                             InsetRect(trect, -RoiHandleSize, -RoiHandleSize);
  1898.                         UpdateScreen(trect);
  1899.                     end;
  1900.                 RoiType := NoRoi;
  1901.                 RoiUpdateTime := 0;
  1902.             end;
  1903.     end;
  1904.  
  1905.  
  1906.     procedure ShowRoi;
  1907.     begin
  1908.         with info^ do
  1909.             if RoiType <> NoRoi then begin
  1910.                     SetupUndo;
  1911.                     RoiShowing := true;
  1912.                 end;
  1913.     end;
  1914.  
  1915.  
  1916.     procedure SetupUndo;
  1917.         var
  1918.             line: integer;
  1919.     begin
  1920.         WhatToUndo := NothingToUndo;
  1921.         if info = NoInfo then begin
  1922.                 CurrentUndoSize := 0;
  1923.                 exit(SetupUndo)
  1924.             end;
  1925.         with info^ do begin
  1926.                 if PixMapSize > UndoBufSize then begin
  1927.                         CurrentUndoSize := 0;
  1928.                         exit(SetupUndo)
  1929.                     end;
  1930.                 if OpPending then begin
  1931.                         DoOperation(CurrentOp);
  1932.                         OpPending := false;
  1933.                     end;
  1934.                 CurrentUndoSize := PixMapSize;
  1935.                 BlockMove(PicBaseAddr, UndoBuf, PixMapSize);
  1936.                 UndoFromClip := false;
  1937.                 RedoSelection := false;
  1938.             end;
  1939.     end;
  1940.  
  1941.  
  1942.     procedure SetupUndoFromClip;
  1943.         var
  1944.             line: integer;
  1945.     begin
  1946.         WhatToUndo := NothingToUndo;
  1947.         if info = NoInfo then begin
  1948.                 CurrentUndoSize := 0;
  1949.                 exit(SetupUndoFromClip)
  1950.             end;
  1951.         with info^ do begin
  1952.                 if PixMapSize > ClipBufSize then begin
  1953.                         CurrentUndoSize := 0;
  1954.                         exit(SetupUndoFromClip)
  1955.                     end;
  1956.                 if OpPending then begin
  1957.                         DoOperation(CurrentOp);
  1958.                         OpPending := false;
  1959.                     end;
  1960.                 CurrentUndoSize := PixMapSize;
  1961.                 BlockMove(PicBaseAddr, ClipBuf, PixMapSize);
  1962.             end;
  1963.         WhatsOnClip := NothingOnClip;
  1964.         UndofromClip := true;
  1965.         RedoSelection := false;
  1966.     end;
  1967.  
  1968.  
  1969.     function NoSelection: boolean;
  1970.     begin
  1971.         if Info = NoInfo then begin
  1972.                 beep;
  1973.                 NoSelection := true;
  1974.                 exit(NoSelection);
  1975.             end;
  1976.         if not Info^.RoiShowing then begin
  1977.                 PutError('Please use a selection tool to make a selection or use the Select All command.');
  1978.                 AbortMacro;
  1979.             end;
  1980.         NoSelection := not Info^.RoiShowing;
  1981.     end;
  1982.  
  1983.  
  1984.     function NotRectangular;{:boolean}
  1985.     begin
  1986.         with info^ do
  1987.             if RoiShowing and (RoiType <> RectRoi) then begin
  1988.                     PutError('This operation requires a rectangular selection.');
  1989.                     NotRectangular := true;
  1990.                     AbortMacro;
  1991.                 end
  1992.             else
  1993.                 NotRectangular := false;
  1994.     end;
  1995.  
  1996.  
  1997.     procedure GetLoi (var x1, y1, x2, y2: extended);
  1998.     begin
  1999.         with info^, info^.RoiRect do begin
  2000.                 x1 := left + LX1;
  2001.                 y1 := top + LY1;
  2002.                 x2 := left + LX2;
  2003.                 y2 := top + LY2;
  2004.             end;
  2005.     end;
  2006.  
  2007.  
  2008.     function NotInBounds: boolean;
  2009.         var
  2010.             x1, y1, x2, y2: extended;
  2011.     begin
  2012.         NotInBounds := false;
  2013.         with info^, info^.RoiRect do
  2014.             if RoiShowing then begin
  2015.                     if RoiType = LineRoi then begin
  2016.                             GetLoi(x1, y1, x2, y2);
  2017.                             if (x1 >= 0.0) and (y1 >= 0.0) and (x2 <= right) and (y2 <= bottom) then
  2018.                                 exit(NotInBounds);
  2019.                         end;
  2020.                     if (left < 0) or (top < 0) or (right > PicRect.right) or (bottom > PicRect.bottom) then begin
  2021.                             PutError('This operation requires the selection to be entirely within the image.');
  2022.                             NotInBounds := true;
  2023.                             AbortMacro;
  2024.                         end;
  2025.                 end;
  2026.     end;
  2027.  
  2028.  
  2029.     function NoUndo: boolean;
  2030.         var
  2031.             ImageTooLarge: boolean;
  2032.     begin
  2033.         with info^ do
  2034.             ImageTooLarge := (PixMapSize > ClipBufSize) or (PixMapSize > UndoBufSize);
  2035.         if ImageTooLarge then
  2036.             PutError('This operation requires that the Undo and Clipboard buffers be at least as large as the image.');
  2037.         NoUndo := ImageTooLarge;
  2038.     end;
  2039.  
  2040.  
  2041.  
  2042.     procedure PutMemoryAlert;
  2043.     begin
  2044.         if not OpeningFinderFiles then
  2045.             PutError('There is not enough free memory to open this image. Try closing some windows or allocating more memory to NIH Image.');
  2046.         AbortMacro;
  2047.     end;
  2048.  
  2049.  
  2050.     procedure CompactMemory;
  2051.         var
  2052.             size: LongInt;
  2053.             TempInfo: InfoPtr;
  2054.             i: integer;
  2055.     begin
  2056.         for i := 1 to nPics do begin
  2057.                 TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  2058.                 hunlock(TempInfo^.PicBaseHandle)
  2059.             end;
  2060.         size := MaxSize;
  2061.         size := MaxMem(size);
  2062.         for i := 1 to nPics do begin
  2063.                 TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  2064.                 with TempInfo^ do begin
  2065.                         hlock(PicBaseHandle);
  2066.                         {$ifc PowerPC}
  2067.                         PicBaseAddr := PicBaseHandle^;
  2068.                         {$elsec}
  2069.                         PicBaseAddr := StripAddress(PicBaseHandle^);
  2070.                         {$endc}
  2071.                         osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
  2072.                     end;
  2073.             end;
  2074.     end;
  2075.  
  2076.  
  2077.  
  2078.     function GetBigHandle (NeededSize: LongInt): handle;
  2079. {Allocates a handle and guarantees MinFree contiguous free bytes after allocation . }
  2080. {Does NOT arrange for the new handle to be unlocked during CompactMemory. }
  2081. {GetBigHandle returns nil if CompactMemory fails to obtain enough contiguous free space . }
  2082.         var
  2083.             h: handle;
  2084.             FreeMem: LongInt;
  2085.     begin
  2086.         h := NewHandle(NeededSize);
  2087.         FreeMem := MaxBlock;
  2088.         if (h = nil) or (FreeMem < MinFree) then begin
  2089.                 if h <> nil then
  2090.                     DisposeHandle(h);
  2091.                 if FreeMem > 0 then {Why does FreeMem get set to 0 sometimes and MaxMem}
  2092.                     CompactMemory       {crash, but only when using the Modern Memory Manager?}
  2093.                 else
  2094.                     beep;
  2095.                 h := NewHandle(NeededSize);
  2096.                 FreeMem := MaxBlock;
  2097.             end;
  2098.         if (h = nil) or (FreeMem < MinFree) then begin
  2099.                 if h <> nil then
  2100.                     DisposeHandle(h);
  2101.                 h := nil;
  2102.             end;
  2103.         GetBigHandle := h;
  2104.     end;
  2105.  
  2106.  
  2107.     function GetImageMemory (SaveInfo: infoPtr): ptr;
  2108. {Allocates memory for the PixMap of new image windows. SaveInfo points to the InfoRec of the previous window.}
  2109. {A handle is used, rather than a pointer, since NewPtr(particularly on the ci and fx) is rediculously slow.}
  2110.         var
  2111.             h: handle;
  2112.             NeededSize: LongInt;
  2113.     begin
  2114.         with info^ do begin
  2115.                 if odd(PixelsPerLine) then
  2116.                     BytesPerRow := PixelsPerLine + 1
  2117.                 else
  2118.                     BytesPerRow := PixelsPerLine;
  2119.                 PixMapSize := nlines * BytesPerRow;
  2120.                 ImageSize := nlines * PixelsPerLine;
  2121.                 NeededSize := PixMapSize;
  2122.             end;
  2123.         h := GetBigHandle(NeededSize);
  2124.         if h = nil then begin
  2125.                 DisposePtr(pointer(Info));
  2126.                 PutMemoryAlert;
  2127.                 Info := SaveInfo;
  2128.                 GetImageMemory := nil;
  2129.                 exit(GetImageMemory);
  2130.             end;
  2131.         with info^ do begin
  2132.                 PicBaseHandle := h;
  2133.                 hlock(PicBaseHandle);
  2134.                 {$ifc PowerPC}
  2135.                 GetImageMemory := PicBaseHandle^;
  2136.                 {$elsec}
  2137.                 GetImageMemory := StripAddress(PicBaseHandle^);
  2138.                 {$endc}
  2139.             end;
  2140.     end;
  2141.  
  2142.  
  2143.     procedure UpdateAnalysisMenu;
  2144.         var
  2145.             ShowItems: boolean;
  2146.             i: integer;
  2147.     begin
  2148.         ShowItems := Info <> NoInfo;
  2149.         SetMenuItem(AnalyzemenuH, MeasureItem, ShowItems);
  2150.         SetMenuItem(AnalyzemenuH, AnalyzeItem, ShowItems);
  2151.         SetMenuItem(AnalyzemenuH, HistogramItem, ShowItems);
  2152.         SetMenuItem(AnalyzemenuH, PlotItem, ShowItems);
  2153.         SetMenuItem(AnalyzemenuH, PlotSurfaceItem, ShowItems);
  2154.         SetMenuItem(AnalyzemenuH, SetScaleItem, ShowItems);
  2155.         SetMenuItem(AnalyzemenuH, CalibrateItem, ShowItems);
  2156.         SetMenuItem(AnalyzemenuH, RedoItem, mCount > 0);
  2157.         SetMenuItem(AnalyzemenuH, DeleteItem, mCount > 0);
  2158.         SetMenuItem(AnalyzemenuH, RestoreItem, ShowItems and (NoInfo^.RoiType <> NoRoi));
  2159.         SetMenuItem(AnalyzemenuH, MarkItem, info^.RoiShowing);
  2160.     end;
  2161.  
  2162.  
  2163.     procedure ExtendWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
  2164.         var
  2165.             str, SizeStr: str255;
  2166.     begin
  2167.         if nPics < MaxPics then begin
  2168.                 nPics := nPics + 1;
  2169.                 PicWindow[nPics] := wptr;
  2170.                 NumToString((size + 511) div 1024, SizeStr);
  2171.                 str := concat(fname, '  ', SizeStr, 'K');
  2172.                 AppendMenu(WindowsMenuH, ' ');
  2173.                 SetMenuItemText(WindowsMenuH, nPics + WindowsMenuItems + nTextWindows, str);
  2174.                 InsertMenu(WindowsMenuH, 0);
  2175.             end;
  2176.     end;
  2177.  
  2178.  
  2179.     procedure InvertGrayLevels;
  2180.     begin
  2181.         with info^ do begin
  2182.                 fit := StraightLine;
  2183.                 nCoefficients := 2;
  2184.                 Coefficient[1] := 255.0;
  2185.                 Coefficient[2] := -1.0;
  2186.                 ZeroClip := false;
  2187.                 UnitOfMeasure := '';
  2188.                 nKnownValues := 0;
  2189.                 NoInfo^.fit := StraightLine;
  2190.                 NoInfo^.nCoefficients := 2;
  2191.                 NoInfo^.Coefficient := Coefficient;
  2192.                 NoInfo^.ZeroClip := false;
  2193.                 NoInfo^.UnitOfMeasure := '';
  2194.                 GenerateValues;
  2195.                 UpdateTitleBar;
  2196.             end;
  2197.     end;
  2198.  
  2199.  
  2200.     function GetAngle (dx, dy: extended):extended;
  2201.         var
  2202.             angle:extended;
  2203.             quadrant: (q1, q2orq3, q4);
  2204.     begin
  2205.         if dx <> 0.0 then
  2206.             angle := arctan(dy / dx)
  2207.         else begin
  2208.                 if dy >= 0.0 then
  2209.                     angle := pi / 2.0
  2210.                 else
  2211.                     angle := -pi / 2.0
  2212.             end;
  2213.         angle := (180.0 / pi) * angle;
  2214.         if (dx >= 0.0) and (dy >= 0.0) then
  2215.             quadrant := q1
  2216.         else if dx < 0.0 then
  2217.             quadrant := q2orq3
  2218.         else
  2219.             quadrant := q4;
  2220.         case quadrant of
  2221.             q1: 
  2222.                 ;
  2223.             q2orq3: 
  2224.                 angle := angle + 180.0;
  2225.             q4: 
  2226.                 angle := angle + 360.0;
  2227.         end;
  2228.         GetAngle:=angle; {ppc-bug}
  2229.     end;
  2230.  
  2231.  
  2232.     procedure MakeRegion;
  2233.         var
  2234.             deltax, deltay, x1, y1, x2, y2, xt, yt: integer;
  2235.             dx, dy, pAngle: extended;
  2236.             add: boolean;
  2237.             tPort: GrafPtr;
  2238.     begin
  2239.         with info^ do begin
  2240.                 GetPort(tPort);
  2241.                 SetPort(wptr);
  2242.                 OpenRgn;
  2243.                 case RoiType of
  2244.                     LineRoi:  begin
  2245.                             LAngle:=GetAngle(LX2 - LX1, LY1 - LY2);
  2246.                             x1 := round(LX1);
  2247.                             y1 := round(LY1);
  2248.                             x2 := round(LX2);
  2249.                             y2 := round(LY2);
  2250.                             if (x1 = x2) and (y1 = y2) then begin
  2251.                                     MoveTo(x1, y1);
  2252.                                     LineTo(x1 + 1, y1);
  2253.                                     LineTo(x1 + 1, y1 + 1);
  2254.                                     LineTo(x1, y1 + 1);
  2255.                                     LineTo(x1, y1);
  2256.                                 end
  2257.                             else begin
  2258.                                     add := (LAngle > 90.0) and (LAngle <= 270.0);
  2259.                                     pAngle := (LAngle / 180.0) * pi;
  2260.                                     if add then
  2261.                                         pAngle := pAngle + pi / 2.0
  2262.                                     else
  2263.                                         pAngle := pAngle - pi / 2.0;
  2264.                                     dx := cos(pAngle) * LineWidth;
  2265.                                     dy := -sin(pAngle) * LineWidth;
  2266.                                     MoveTo(x1, y1);
  2267.                                     LineTo(round(x1 + dx), round(y1 + dy));
  2268.                                     LineTo(round(x2 + dx), round(y2 + dy));
  2269.                                     LineTo(x2, y2);
  2270.                                     LineTo(x1, y1);
  2271.                                 end;
  2272.                         end;
  2273.                     OvalRoi: 
  2274.                         FrameOval(RoiRect);
  2275.                     RectRoi: 
  2276.                         FrameRect(RoiRect);
  2277.                     otherwise
  2278.                 end;
  2279.                 CloseRgn(roiRgn);
  2280.                 if RoiType = LineRoi then begin
  2281.                         RoiRect := roiRgn^^.rgnBBox;
  2282.                         with RoiRect do begin
  2283.                                 LX1 := LX1 - left;
  2284.                                 LY1 := LY1 - top;
  2285.                                 LX2 := LX2 - left;
  2286.                                 LY2 := LY2 - top;
  2287.                             end;
  2288.                     end;
  2289.             end;
  2290.         SetPort(tPort);
  2291.     end;
  2292.  
  2293.  
  2294.     procedure SelectAll (visible: boolean);
  2295.         var
  2296.             loc: point;
  2297.             tPort: GrafPtr;
  2298.     begin
  2299.         if info <> NoInfo then
  2300.             with Info^ do begin
  2301.                     KillRoi;
  2302.                     RoiType := RectRoi;
  2303.                     RoiRect := PicRect;
  2304.                     MakeRegion;
  2305.                     if visible then begin
  2306.                             SetupUndo;
  2307.                             RoiShowing := true;
  2308.                             if (magnification > 1.0) and not ScaleToFitWindow then
  2309.                                 Unzoom;
  2310.                             if not macro then begin
  2311.                                     PreviousTool := CurrentTool;
  2312.                                     CurrentTool := SelectionTool;
  2313.                                     isSelectionTool := true;
  2314.                                     GetPort(tPort);
  2315.                                     SetPort(ToolWindow);
  2316.                                     EraseRect(ToolRect[PreviousTool]);
  2317.                                     EraseRect(ToolRect[CurrentTool]);
  2318.                                     InvalRect(ToolRect[PreviousTool]);
  2319.                                     InvalRect(ToolRect[CurrentTool]);
  2320.                                     SetPort(tPort);
  2321.                                 end;
  2322.                         end;
  2323.                     IsInsertionPoint := false;
  2324.                     measuring := false;
  2325.                 end; {with}
  2326.     end;
  2327.  
  2328.  
  2329.     procedure KillOperation;
  2330.     begin
  2331.         if OpPending then
  2332.             with info^ do
  2333.                 if info <> NoInfo then begin
  2334.                         DoOperation(CurrentOp);
  2335.                         RoiShowing := false;
  2336.                         UpdateScreen(RoiRect);
  2337.                         OpPending := false;
  2338.                     end;
  2339.     end;
  2340.  
  2341.  
  2342.     procedure CloneInfo (var OldInfo, NewInfo: PicInfo);
  2343.     begin
  2344.         NewInfo := OldInfo;
  2345.         with NewInfo do begin
  2346.                 PicBaseAddr := nil;
  2347.                 PicBaseHandle := nil;
  2348.                 osPort := nil;
  2349.                 roiRgn := nil;
  2350.                 RoiType := NoRoi;
  2351.                 RoiShowing := false;
  2352.                 Magnification := 1.0;
  2353.                 vref := 0;
  2354.                 wPtr := nil;
  2355.                 ScaleToFitWindow := false;
  2356.                 WindowState := NormalWindow;
  2357.                 StackInfo := nil;
  2358.                 fileVersion := 0;
  2359.                 PictureType := NewPicture;
  2360.                 DataType := EightBits;
  2361.                 changes := false;
  2362.                 DataH := nil;
  2363.                 LittleEndian := false;
  2364.                 InvertedImage := false;
  2365.                 if OldInfo.DataH <> nil then {real image}
  2366.                     fit := uncalibrated;
  2367.                 if (not SpatiallyCalibrated and (fit=uncalibrated)) or (nPics=0) then begin
  2368.                     if NoInfo^.SpatiallyCalibrated then begin
  2369.                         SpatiallyCalibrated:=true;
  2370.                         xUnit := NoInfo^.xUnit;
  2371.                         xScale := NoInfo^.xScale;
  2372.                         PixelAspectRatio := NoInfo^.PixelAspectRatio;
  2373.                         yScale := xScale / PixelAspectRatio;
  2374.                     end;
  2375.                     if NoInfo^.fit<>uncalibrated then begin
  2376.                         fit := NoInfo^.fit;
  2377.                         nCoefficients := NoInfo^.nCoefficients;
  2378.                         Coefficient := NoInfo^.Coefficient;
  2379.                         ZeroClip := NoInfo^.ZeroClip;
  2380.                         UnitOfMeasure := NoInfo^.UnitOfMeasure;
  2381.                     end;
  2382.                 end;
  2383.             end;
  2384.     end;
  2385.  
  2386.  
  2387.     function NewPicWindow (name: str255; width, height: integer): boolean;
  2388.         var
  2389.             iptr, p: ptr;
  2390.             lptr: ^LongInt;
  2391.             SaveInfo: InfoPtr;
  2392.             NeededSize: LongInt;
  2393.             trect: rect;
  2394.     begin
  2395.         NewPicWindow := false;
  2396.         PicLeft := PicLeftBase;
  2397.         PicTop := PicTopBase;
  2398.         if (info <> noInfo) then begin
  2399.                 with info^ do begin
  2400.                         GetWindowRect(wptr, trect);
  2401.                         if trect.left = PicLeftBase then
  2402.                             if pos('Camera', name) = 0 then begin
  2403.                                     PicLeft := trect.left + hPicOffset;
  2404.                                     PicTop := trect.top + vPicOffset;
  2405.                                 end;
  2406.                     end;
  2407.             end;
  2408.         if nPics = MaxPics then
  2409.             exit(NewPicWindow);
  2410.         KillOperation;
  2411.         DisableDensitySlice;
  2412.         SaveInfo := Info;
  2413.         iptr := NewPtr(SizeOf(PicInfo));
  2414.         if iptr = nil then begin
  2415.                 PutMemoryAlert;
  2416.                 AbortMacro;
  2417.                 exit(NewPicWindow);
  2418.             end;
  2419.         Info := pointer(iptr);
  2420.         CloneInfo(SaveInfo^, Info^);
  2421.         with Info^ do begin
  2422.                 nlines := height;
  2423.                 PixelsPerLine := width;
  2424.                 p := GetImageMemory(SaveInfo);
  2425.                 if p = nil then
  2426.                     exit(NewPicWindow);
  2427.                 PicBaseAddr := p;
  2428.                 MakeNewWindow(name);
  2429.                 SelectAll(false);
  2430.                 if not OptionKeyDown then DoOperation(EraseOp);
  2431.                 KillRoi;
  2432.                 Changes := false;
  2433.                 BinaryPic := false;
  2434.             end;
  2435.         UpdateTitleBar;
  2436.         NewPicWindow := true;
  2437.     end;
  2438.  
  2439.  
  2440.     procedure EraseScreen;
  2441.     begin
  2442.         SetPort(GrafPtr(CScreenPort));
  2443.         with CScreenPort^ do begin
  2444.                 HideCursor;
  2445.                 pmBackColor(BackgroundIndex);
  2446.                 EraseRect(portPixMap^^.Bounds);
  2447.                 pmBackColor(WhiteIndex);
  2448.             end;
  2449.     end;
  2450.  
  2451.  
  2452.     procedure RestoreScreen;
  2453.         var
  2454.             GrayRgn: RgnHandle;
  2455.             rptr: rhptr;
  2456.             wp: ^WindowPtr;
  2457.     begin
  2458.         rptr := rhptr(GrayRgnGlobal);
  2459.         GrayRgn := rptr^;
  2460.         wp := pointer(GhostWindow);
  2461.         wp^ := WindowPtr(nil);
  2462.         PaintBehind(WindowRef(FrontWindow), GrayRgn);
  2463.         wp^ := PasteControl;
  2464.         DrawMenuBar;
  2465.         InitCursor;
  2466.     end;
  2467.  
  2468.  
  2469.     procedure UpdateTitleBar;
  2470.     {Updates the window title bar to show the current magnification or the current frame within a stack.}
  2471.         var
  2472.             str, str2, str3: str255;
  2473.     begin
  2474.         if info = NoInfo then
  2475.             exit(UpdateTitleBar);
  2476.         with info^ do begin
  2477.                 str := title;
  2478.                 if info^.DataH <> nil then
  2479.                     str := concat('<<',str, '>>');
  2480.                 if SpatiallyCalibrated then
  2481.                     str := concat(str, chr($13)); {Black Diamond}
  2482.                 if fit <> uncalibrated then
  2483.                     str := concat(str, '◊');
  2484.                 if StackInfo <> nil then
  2485.                     with StackInfo^ do
  2486.                         if (nSlices = 3) and (StackType = rgbStack) then begin
  2487.                                 case CurrentSlice of
  2488.                                     1: str2 := 'Red';
  2489.                                     2: str2 := 'Green';
  2490.                                     3: str2 := 'Blue';
  2491.                                 end;
  2492.                                 str := concat(str, ' (', str2, ')');
  2493.                         end else begin
  2494.                                 NumToString(CurrentSlice, str2);
  2495.                                 NumToString(nSlices, str3);
  2496.                                 str := concat(str, ' (', str2, '/', str3, ')');
  2497.                         end
  2498.                 else if (magnification <> 1.0) or ScaleToFitWindow then begin
  2499.                         if ScaleToFitWindow then begin
  2500.                                 RealToString(magnification, 1, 2, str2);
  2501.                                 str := concat(str, ' (', str2, ')');
  2502.                             end
  2503.                         else begin
  2504.                                 RealToString(magnification, 1, 0, str2);
  2505.                                 str := concat(str, ' (', str2, ':1)');
  2506.                             end;
  2507.                     end;
  2508.                 if Digitizing then begin
  2509.                         if ExternalTrigger then
  2510.                             str := concat(str, ' (Waiting for Trigger)')
  2511.                         else
  2512.                             str := concat(str, ' (Live)');
  2513.                     end;
  2514.                 if wptr <> nil then
  2515.                     SetWTitle(wptr, str);
  2516.             end; {with}
  2517.     end;
  2518.  
  2519.  
  2520.     procedure ScaleToFit;
  2521.         var
  2522.             trect: rect;
  2523.     begin
  2524.         if digitizing then
  2525.             exit(ScaleToFit);
  2526.         if info <> NoInfo then
  2527.             with info^ do begin
  2528.                     ScaleToFitWindow := not ScaleToFitWindow;
  2529.                     KillRoi;
  2530.                     if ScaleToFitWindow then begin
  2531.                             savewrect := wrect;
  2532.                             SaveSrcRect := SrcRect;
  2533.                             SaveMagnification := magnification;
  2534.                             GetWindowRect(wptr, trect);
  2535.                             savehloc := trect.left;
  2536.                             savevloc := trect.top;
  2537.                             wrect := wptr^.PortRect;
  2538.                             SrcRect := PicRect;
  2539.                             ScaleImageWindow(wrect);
  2540.                             SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2541.                         end
  2542.                     else begin
  2543.                             if WindowState = TiledBigScaled then begin
  2544.                                     wrect := initwrect;
  2545.                                     SrcRect := wrect;
  2546.                                     magnification := 1.0;
  2547.                                     WindowState := NormalWindow;
  2548.                                 end
  2549.                             else begin
  2550.                                     wrect := savewrect;
  2551.                                     SrcRect := SaveSrcRect;
  2552.                                     magnification := SaveMagnification;
  2553.                                 end;
  2554.                             HideWindow(wptr);
  2555.                             SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2556.                             MoveWindow(wptr, savehloc, savevloc, true);
  2557.                             ShowWindow(wptr);
  2558.                             UpdateTitleBar;
  2559.                         end;
  2560.                     SetPort(wptr);
  2561.                     InvalRect(wrect);
  2562.                     WindowState := NormalWindow;
  2563.                 end;
  2564.     end;
  2565.  
  2566.  
  2567.     procedure DrawMyGrowIcon (w: WindowPtr);
  2568.         var
  2569.             tPort: GrafPtr;
  2570.             tRect: rect;
  2571.     begin
  2572.         GetPort(tPort);
  2573.         SetPort(w);
  2574.         PenNormal;
  2575.         with w^.PortRect do begin
  2576.                 SetRect(tRect, right - 12, bottom - 12, right - 5, bottom - 5);
  2577.                 FrameRect(tRect);
  2578.                 MoveTo(right - 6, bottom - 10);
  2579.                 LineTo(right - 2, bottom - 10);
  2580.                 LineTo(right - 2, bottom - 2);
  2581.                 LineTo(right - 10, bottom - 2);
  2582.                 LineTo(right - 10, bottom - 6);
  2583.             end;
  2584.         SetPort(tPort);
  2585.     end;
  2586.  
  2587.  
  2588.     procedure Unzoom;
  2589.     begin
  2590.         if Info <> NoInfo then
  2591.             with Info^ do begin
  2592.                     ScaleToFitWindow:=false;
  2593.                     wrect := initwrect;
  2594.                     SrcRect := wrect;
  2595.                     SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2596.                     LoadLUT(info^.cTable);
  2597.                     UpdatePicWindow;
  2598.                     magnification := 1.0;
  2599.                     DrawMyGrowIcon(wptr);
  2600.                     UpdateTitleBar;
  2601.                     WindowState:=NormalWindow;
  2602.                     if WhatToUndo = UndoZoom then
  2603.                         WhatToUndo := NothingToUndo;
  2604.                     ShowRoi;
  2605.                 end;
  2606.     end;
  2607.  
  2608.  
  2609.     procedure DrawBString(str:string);
  2610.     var
  2611.         s:style;
  2612.     begin
  2613.         TextFace([bold]);
  2614.         DrawString(str);
  2615.         s:=[];  {ppc-bug}
  2616.         TextFace(s);
  2617.     end;
  2618.  
  2619.  
  2620.     function long2str (num: LongInt): str255;
  2621.         var
  2622.             str: str255;
  2623.     begin
  2624.         NumToString(num, str);
  2625.         long2str := str;
  2626.     end;
  2627.  
  2628.  
  2629.     procedure PutWarning;
  2630.     begin
  2631.         PutError(concat('This ', long2str((info^.PixmapSize + 511) div 1024), 'K image is larger than the ', long2str(UndoBufSize div 1024), 'K Undo buffer. Many operations may fail or be Undoable.'));
  2632.     end;
  2633.  
  2634.  
  2635.     procedure SetupRoiRect;
  2636. {Copies the current image to Undo buffer so it can be used for drawing}
  2637. {the "marching ants". The copy of the previous image in the Clipboard buffer}
  2638. { buffer will be used for Undo.}
  2639.         var
  2640.             SaveWhatToUndo: WhatToUndoType;
  2641.     begin
  2642.         SaveWhatToUndo := WhatToUndo;
  2643.         SetupUndo;
  2644.         UndoFromClip := true;
  2645.         info^.RoiShowing := true;
  2646.         WhatToUndo := SaveWhatToUndo;
  2647.     end;
  2648.  
  2649.  
  2650.     procedure SetForegroundColor (color: integer);
  2651.         var
  2652.             tPort: GrafPtr;
  2653.             SaveGDevice: GDHandle;
  2654.     begin
  2655.         if (color >= 0) and (color <= 255) then
  2656.             with info^ do begin
  2657.                     ForegroundIndex := color;
  2658.                     GetPort(tPort);
  2659.                     SetPort(ToolWindow);
  2660.                     InvalRect(ToolRect[brush]);
  2661.                     SaveGDevice := GetGDevice;
  2662.                     SetGDevice(osGDevice);
  2663.                     if osPort <> nil then begin
  2664.                             SetPort(GrafPtr(osPort));
  2665.                             pmForeColor(ForegroundIndex);
  2666.                         end;
  2667.                     SetPort(tPort);
  2668.                     SetGDevice(SaveGDevice);
  2669.                     if isInsertionPoint then
  2670.                         DisplayText(true);
  2671.                 end;
  2672.     end;
  2673.  
  2674.  
  2675.     procedure SetBackgroundColor (color: integer);
  2676.         var
  2677.             tPort: GrafPtr;
  2678.             SaveGDevice: GDHandle;
  2679.     begin
  2680.         if (color >= 0) and (color <= 255) then
  2681.             with info^ do begin
  2682.                     BackgroundIndex := color;
  2683.                     GetPort(tPort);
  2684.                     SetPort(ToolWindow);
  2685.                     InvalRect(ToolRect[eraser]);
  2686.                     SaveGDevice := GetGDevice;
  2687.                     SetGDevice(osGDevice);
  2688.                     if osPort <> nil then begin
  2689.                             SetPort(GrafPtr(osPort));
  2690.                             pmBackColor(BackgroundIndex);
  2691.                         end;
  2692.                     SetPort(tPort);
  2693.                     SetGDevice(SaveGDevice);
  2694.                     if isInsertionPoint then
  2695.                         DisplayText(true);
  2696.                 end;
  2697.     end;
  2698.  
  2699.  
  2700.     procedure GetForegroundColor (event: EventRecord);
  2701.         var
  2702.             loc: point;
  2703.             color: integer;
  2704.     begin
  2705.         loc := event.where;
  2706.         ScreenToOffScreen(loc);
  2707.         Color := MyGetPixel(loc.h, loc.v);
  2708.         SetForegroundColor(color);
  2709.     end;
  2710.  
  2711.  
  2712.     procedure GetBackgroundColor; {(event: EventRecord)}
  2713.         var
  2714.             loc: point;
  2715.             color: integer;
  2716.     begin
  2717.         loc := event.where;
  2718.         ScreenToOffScreen(loc);
  2719.         Color := MyGetPixel(loc.h, loc.v);
  2720.         SetBackgroundColor(color);
  2721.     end;
  2722.  
  2723.  
  2724. procedure GenerateValues;
  2725.         var
  2726.             a, b, c, d, e, f, x, y: extended;
  2727.             i: integer;
  2728.     begin
  2729.         with info^ do begin
  2730.                 if fit = uncalibrated then begin
  2731.                         for i := 0 to 255 do
  2732.                             cvalue[i] := i;
  2733.                         minCValue := 0.0;
  2734.                         maxCValue := 255.0;
  2735.                         exit(GenerateValues);
  2736.                     end;
  2737.                 a := Coefficient[1];
  2738.                 b := Coefficient[2];
  2739.                 c := Coefficient[3];
  2740.                 d := Coefficient[4];
  2741.                 e := Coefficient[5];
  2742.                 f := Coefficient[6];
  2743.                 minCValue := 10e+12;
  2744.                 maxCValue := -minCValue;
  2745.                 for i := 0 to 255 do begin
  2746.                         x := i;
  2747.                         case fit of
  2748.                             StraightLine: 
  2749.                                 y := a + b * x;
  2750.                             Poly2: 
  2751.                                 y := a + b * x + c * x * x;
  2752.                             Poly3: 
  2753.                                 y := a + b * x + c * x * x + d * x * x * x;
  2754.                             Poly4: 
  2755.                                 y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x;
  2756.                             Poly5: 
  2757.                                 y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x + f * x * x * x * x * x;
  2758.                             ExpoFit: 
  2759.                                 y := a * exp(b * x);
  2760.                             PowerFit: 
  2761.                                 if x = 0.0 then
  2762.                                     y := 0.0
  2763.                                 else
  2764.                                     y := a * exp(b * ln(x)); {y=ax^b}
  2765.                             LogFit:  begin
  2766.                                     if x = 0.0 then
  2767.                                         x := 0.5;
  2768.                                     y := a * ln(b * x)
  2769.                                 end;
  2770.                             RodbardFit:  begin
  2771.                                     if x <= a then
  2772.                                         y := 0
  2773.                                     else begin
  2774.                                             y := (a - x) / (x - d);
  2775.                                             y := exp(ln(y) * (1 / b));  {y:=y**(1/b)}
  2776.                                             y := y * c;
  2777.                                         end;
  2778.                                 end;
  2779.                             UncalibratedOD:  begin
  2780.                                     if x = 255.0 then
  2781.                                         x := 254.5;
  2782.                                     y := 0.434294481 * ln(255.0 / (255.0 - x))  {log10}
  2783.                                 end;
  2784.                             otherwise
  2785.                                 y := x;
  2786.                         end; {case}
  2787.                         cvalue[i] := y;
  2788.                         if y > maxCValue then
  2789.                             maxCValue := y;
  2790.                         if y < minCValue then
  2791.                             minCValue := y;
  2792.                     end; {for}
  2793.                 if minCValue >= 0.0 then
  2794.                     ZeroClip := false;
  2795.                 if ZeroClip then begin
  2796.                         for i := 0 to 255 do
  2797.                             if cvalue[i] < 0.0 then
  2798.                                 cvalue[i] := 0.0;
  2799.                         minCValue := 0.0;
  2800.                     end;
  2801.             end;
  2802.     end;
  2803.  
  2804.  
  2805.     procedure ScaleImageWindow (var trect: rect);
  2806.         var
  2807.             WindowLeft, WindowTop: integer;
  2808.             PicAspectRatio, TempMagnification: extended;
  2809.     begin
  2810.         with info^ do begin
  2811.                 SrcRect := PicRect;
  2812.                 with CGrafPtr(wptr)^.PortPixMap^^.bounds do begin
  2813.                         WindowLeft := -left;
  2814.                         WindowTop := -top;
  2815.                     end;
  2816.     with PicRect do
  2817.                     PicAspectRatio := right / bottom;
  2818.                 with trect do begin
  2819.                         if (WindowLeft + right) > (ScreenWidth - 5) then
  2820.                             right := ScreenWidth - 5 - WindowLeft;
  2821.                         bottom := round(right / PicAspectRatio);
  2822.                         if (WindowTop + bottom) > (ScreenHeight - 5) then
  2823.                             bottom := ScreenHeight - 5 - WindowTop;
  2824.                         right := round(bottom * PicAspectRatio);
  2825.                         magnification := right / PicRect.right;
  2826.                     end;
  2827.                 UpdateTitleBar;
  2828.             end; {with}
  2829.     end;
  2830.  
  2831.  
  2832.     function TooWide: boolean;
  2833.         var
  2834.             SelectionTooWide: boolean;
  2835.             MaxWidth: str255;
  2836.     begin
  2837.         with info^.RoiRect do
  2838.             SelectionTooWide := (right - left) > MaxLine;
  2839.         if SelectionTooWide then begin
  2840.                 NumToString(MaxLine, MaxWidth);
  2841.                 PutError(concat('This operation does not support selections wider than ', MaxWidth, ' pixels.'));
  2842.                 AbortMacro;
  2843.             end;
  2844.         TooWide := SelectionTooWide;
  2845.     end;
  2846.  
  2847.  
  2848.     procedure DrawTextString (str: str255; loc: point; just: integer);
  2849.         var
  2850.             SaveJust: integer;
  2851.     begin
  2852.         TextStr := str;
  2853.         IsInsertionPoint := true;
  2854.         TextStart := loc;
  2855.         SaveJust := TextJust;
  2856.         TextJust := just;
  2857.         DisplayText(false);
  2858.         TextJust := SaveJust;
  2859.         IsInsertionPoint := false;
  2860.     end;
  2861.  
  2862.  
  2863.     procedure IncrementCounter;
  2864.     begin
  2865.         if mCount < MaxMeasurements then begin
  2866.                 mCount := mCount + 1;
  2867.                 UnsavedResults := true;
  2868.             end
  2869.         else
  2870.             beep;
  2871.     end;
  2872.  
  2873.  
  2874.     procedure ClearResults (i: integer);
  2875.     begin
  2876.         mean^[i] := 0.0;
  2877.         sd^[i] := 0.0;
  2878.         PixelCount^[i] := 0;
  2879.         mArea^[i] := 0.0;
  2880.         mode^[i] := 0.0;
  2881.         IntegratedDensity^[i] := 0.0;
  2882.         idBackground^[i] := 0.0;
  2883.         xcenter^[i] := 0.0;
  2884.         ycenter^[i] := 0.0;
  2885.         MajorAxis^[i] := 0.0;
  2886.         MinorAxis^[i] := 0.0;
  2887.         orientation^[i] := 0.0;
  2888.         mMin^[i] := 0.0;
  2889.         mMax^[i] := 0.0;
  2890.         plength^[i] := 0.0;
  2891.     end;
  2892.  
  2893.     procedure UpdateFitEllipse;
  2894.     begin
  2895.         FitEllipse :=(xyLocM in measurements) or (MajorAxisM in measurements) or (MinorAxisM in measurements) or (AngleM in measurements);
  2896.     end;
  2897.  
  2898.  
  2899.  
  2900.     function StringToReal (str: str255): extended;
  2901.         var
  2902.             i, ndigits, StringLength: integer;
  2903.             c: char;
  2904.             n, m: extended;
  2905.             negative, LeftOfPoint, NegExp: boolean;
  2906.             exponent: LongInt;
  2907.     begin
  2908.         negative := false;
  2909.         n := 0.0;
  2910.         LeftOfPoint := true;
  2911.         m := 0.1;
  2912.         ndigits := 0;
  2913.         StringLength := length(str);
  2914.         i := 0;
  2915.         repeat
  2916.             i := i + 1;
  2917.         until (str[i] in ['0'..'9', '-', '.']) or (i >= StringLength);
  2918.         c := str[i];
  2919.         repeat
  2920.             if c = '-' then
  2921.                 negative := true
  2922.             else if c = '.' then
  2923.                 LeftOfPoint := false
  2924.             else if (c >= '0') and (c <= '9') then begin
  2925.                     ndigits := ndigits + 1;
  2926.                     if LeftOfPoint then
  2927.                         n := n * 10.0 + ord(c) - ord('0')
  2928.                     else begin
  2929.                             n := n + (ord(c) - ord('0')) * m;
  2930.                             m := m * 0.1;
  2931.                         end;
  2932.                 end;
  2933.             i := i + 1;
  2934.             if i <= StringLength then
  2935.                 c := str[i];
  2936.         until not (c in ['0'..'9', '-', '.']) or (i > StringLength);
  2937.         if (c = 'e') or (c = 'E') then begin
  2938.                 NegExp := false;
  2939.                 exponent := 0;
  2940.                 i := i + 1;
  2941.                 if i <= StringLength then
  2942.                     c := str[i];
  2943.                 if (c = '+') or (c = '-') then begin
  2944.                         if c = '-' then
  2945.                             NegExp := true;
  2946.                         i := i + 1;
  2947.                         if i <= StringLength then
  2948.                             c := str[i];
  2949.                     end;
  2950.                 repeat
  2951.                     if (c >= '0') and (c <= '9') then
  2952.                         exponent := exponent * 10 + ord(c) - ord('0');
  2953.                     i := i + 1;
  2954.                     if i <= StringLength then
  2955.                         c := str[i];
  2956.                 until not (c in ['0'..'9']) or (i > StringLength);
  2957.                 if negExp then
  2958.                     exponent := -exponent;
  2959.                 if exponent <> 0 then
  2960.                     n := n * exp(exponent * ln(10));
  2961.             end; {if c='e'}
  2962.         if ndigits = 0 then
  2963.             n := BadReal
  2964.         else if negative then
  2965.             n := -n;
  2966.         StringToReal := n;
  2967.     end;
  2968.  
  2969.  
  2970.     procedure RemovePath(var str: str255);
  2971.     var
  2972.         loc: integer;
  2973.     begin
  2974.         repeat
  2975.             loc := pos(':', str);
  2976.             if loc > 0 then
  2977.                 delete(str, 1, loc);
  2978.         until loc = 0;
  2979.     end;
  2980.  
  2981.  
  2982.     procedure MakeNewWindow (name: str255);
  2983.         var
  2984.             wwidth, wheight, wleft, wtop, i: integer;
  2985.             tPort: GrafPtr;
  2986.             rgb: RGBColor;
  2987.             err: OSErr;
  2988.             str: str255;
  2989.             SaveGDevice: GDHandle;
  2990.     begin
  2991.         with Info^ do begin
  2992.                 RemovePath(name);
  2993.                 wleft := PicLeft;
  2994.                 wtop := PicTop;
  2995.                 PicLeft := PicLeft + hPicOffset;
  2996.                 PicTop := PicTop + vPicOffset;
  2997.                 if ((PicLeft + round(0.75 * PixelsPerLine)) > ScreenWidth) or ((PicTop + round(0.75 * nlines)) > ScreenHeight) then begin
  2998.                         PicLeft := PicLeftBase;
  2999.                         PicTop := PicTopBase;
  3000.                     end;
  3001.                 wwidth := PixelsPerLine;
  3002.                 if (wleft + wwidth) > ScreenWidth then
  3003.                     wwidth := ScreenWidth - wleft - 4;
  3004.                 wheight := nlines;
  3005.                 if (wtop + wheight) > ScreenHeight then
  3006.                     wheight := ScreenHeight - wtop - 4;
  3007.                 if OpeningPlugInWindow then
  3008.                     SetRect(wrect, -10000, wtop, -10000 + wwidth, wtop + wheight)
  3009.                 else
  3010.                     SetRect(wrect, wleft, wtop, wleft + wwidth, wtop + wheight);
  3011.                 str := name;
  3012.                 if SpatiallyCalibrated then
  3013.                     str := concat(str, chr($13)); {Black Diamond}
  3014.                 if fit <> uncalibrated then
  3015.                     str := concat(str, '◊');
  3016.                 wptr := NewCWindow(nil, wrect, str, true, DocumentProc + ZoomDocProc, nil, true, 0);
  3017.                 GetPort(tPort);
  3018.                 SetPort(wptr);
  3019.                 SetPalette(wptr, ExplicitPalette, false);
  3020.                 pmForeColor(BlackIndex);
  3021.                 pmBackColor(WhiteIndex);
  3022.                 SetRect(wrect, 0, 0, wwidth, wheight);
  3023.                 SetRect(PicRect, 0, 0, PixelsPerLine, nlines);
  3024.                 SelectWindow(wptr);
  3025.                 WindowPeek(wptr)^.WindowKind := PicKind;
  3026.                 WindowPeek(wptr)^.RefCon := ord4(Info);
  3027.                 TruncateString(name, maxTitle);
  3028.                 title := name;
  3029.                 ExtendWindowsMenu(name, PixMapSize, wptr);
  3030.                 PicNum := nPics;
  3031.                 PidNum := nextPid;
  3032.                 nextPid := nextPid - 1;
  3033.                 osPort := CGrafPtr(NewPtr(SizeOf(CGrafPort)));
  3034.                 SaveGDevice := GetGDevice;
  3035.                 SetGDevice(osGDevice);
  3036.                 OpenCPort(osPort);
  3037.                 with osPort^ do begin
  3038.                         with PortPixMap^^ do begin
  3039.                                 BaseAddr := PicBaseAddr;
  3040.                                 bounds := PicRect;
  3041.                                 pixelType := 0;
  3042.                                 if PixelSize > 8 then
  3043.                                     PixelSize := 8;
  3044.                                 cmpCount := 1;
  3045.                             end;
  3046.                         PortRect := PicRect;
  3047.                         RectRgn(visRgn, PicRect);
  3048.                         PortPixMap^^.RowBytes := BitOr(BytesPerRow, $8000);
  3049.                     end;
  3050.                 SetPalette(WindowPtr(osPort), ExplicitPalette, false);
  3051.                 pmForeColor(ForegroundIndex);
  3052.                 pmBackColor(BackgroundIndex);
  3053.                 SetGDevice(SaveGDevice);
  3054.                 SetPort(tPort);
  3055.                 SrcRect := wrect;
  3056.                 magnification := 1.0;
  3057.                 RoiShowing := false;
  3058.                 roiType := NoRoi;
  3059.                 initwrect := wrect;
  3060.                 savewrect := wrect;
  3061.                 SaveSrcRect := SrcRect;
  3062.                 SaveMagnification := magnification;
  3063.                 savehloc := wleft;
  3064.                 savevloc := wtop;
  3065.                 roiRgn := NewRgn;
  3066.                 NewPic := true;
  3067.                 ScaleToFitWindow := false;
  3068.                 OpPending := false;
  3069.                 Changes := false;
  3070.                 WindowState := NormalWindow;
  3071.                 if (fit = uncalibrated) and InvertPixelValues then
  3072.                     InvertGrayLevels;
  3073.                 Revertable := false;
  3074.             end;
  3075.         WhatToUndo := NothingToUndo;
  3076.     end;
  3077.  
  3078.  
  3079.     procedure MakeLowerCase (var str: str255);
  3080.         var
  3081.             i: integer;
  3082.             c: char;
  3083.     begin
  3084.         for i := 1 to length(str) do begin
  3085.                 c := str[i];
  3086.                 if (c >= 'A') and (c <= 'Z') then
  3087.                     str[i] := chr(ord(c) + 32);
  3088.             end;
  3089.     end;
  3090.  
  3091.  
  3092.     function PutMessageWithCancel (str: str255): integer;
  3093.     begin
  3094.         InitCursor;
  3095.         ParamText(str, '', '', '');
  3096.         PutMessageWithCancel := Alert(800, nil);
  3097.     end;
  3098.  
  3099.  
  3100.     function CurrentWindow: integer;
  3101.     begin
  3102.         CurrentWPtr := FrontWindow;
  3103.         if CurrentWPtr <> nil then begin
  3104.                 CurrentKind := WindowPeek(CurrentWPtr)^.WindowKind;
  3105.                 if CurrentKind = TextKind then
  3106.                     TextInfo := TextInfoPtr(WindowPeek(CurrentWPtr)^.RefCon);
  3107.                 CurrentWindow := CurrentKind;
  3108.             end
  3109.         else begin
  3110.                 CurrentWindow := 0;
  3111.                 CurrentKind := 0;
  3112.             end;
  3113.     end;
  3114.  
  3115.  
  3116.     procedure FindMonitors (NewScreenDepth: integer);
  3117.   {Generate a list of 8-bit monitors so we can update their LUTs.}
  3118.   {This wouldn't be necessary if we were using the Palette Manager.}
  3119.         var
  3120.             nextDevice: GDHandle;
  3121.     begin
  3122.         nMonitors := 0;
  3123.         nextDevice := GetDeviceList;
  3124.         while nextDevice <> nil do begin
  3125.                 if TestDeviceAttribute(nextDevice, screenDevice) and TestDeviceAttribute(nextDevice, screenActive) then
  3126.                     if nextDevice^^.gdPmap^^.PixelSize = 8 then begin
  3127.                             nMonitors := nMonitors + 1;
  3128.                             Monitors[nMonitors] := nextDevice;
  3129.                         end;
  3130.                 nextDevice := GetNextDevice(nextDevice);
  3131.             end; {while}
  3132.         if NewScreenDepth < 4 then
  3133.             gCopyMode := DitherCopy
  3134.         else
  3135.             gCopyMode := SrcCopy;
  3136.         SaveScreenDepth := NewScreenDepth;
  3137.     end;
  3138.  
  3139.  
  3140.     function ScreenDepth: integer;
  3141.         var
  3142.             depth: integer;
  3143.     begin
  3144.         depth := ScreenPixMap^^.PixelSize;
  3145.         if (depth = 8) and LUTFriendlyMode then
  3146.             depth := 6;
  3147.         if depth <> SaveScreenDepth then
  3148.             FindMonitors(depth);
  3149.         ScreenDepth := depth;
  3150.     end;
  3151.  
  3152.  
  3153.     procedure SetFColor (index: integer);
  3154.   {Sets the screen foreground color. Use pmForeColor to set the offscreen color.}
  3155.     begin
  3156.         if ScreenDepth = 8 then
  3157.             pmForeColor(index)
  3158.         else
  3159.             RGBForeColor(osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb);
  3160.     end;
  3161.  
  3162.     procedure SetBColor (index: integer);
  3163.   {Sets the screen background color.}
  3164.     begin
  3165.         if ScreenDepth = 8 then
  3166.             pmBackColor(index)
  3167.         else
  3168.             RGBBackColor(osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb);
  3169.     end;
  3170.     
  3171.     
  3172.     function DoubleToReal(d:FakeDouble):extended;
  3173.     {Converts an IEEE double to an IEEE float. Will not be needed
  3174.     when "8 Byte Doubles" work in the Metrowerks 68k compiler.}
  3175.     var
  3176.       s, f, r:extended;
  3177.       e:LongInt;
  3178.       dd:double;
  3179.     begin
  3180.         {$ifc PowerPC}
  3181.         dd:=double(d);
  3182.         r:=dd;
  3183.         {$elsec PowerPC}
  3184.         if band(d[1],$80000000)=0 then
  3185.             s:=1
  3186.         else
  3187.             s:=-1;
  3188.         e:=band(d[1],$7ff00000);
  3189.         e:=bsr(e,20);
  3190.         f:=band(d[1],$fffff);
  3191.         f:=f / 1048576.0;
  3192.         f:=f + bsr(d[2],24)/268435456.0;
  3193.         {ShowMessage(StringOf('s=',s , ' e=', e, ' f=', f));}
  3194.         if (e > 0) and (e < 2047) then 
  3195.             r:=s * exp((e-1023)*ln(2.0)) * (1.0 + f)
  3196.         else if (e = 0) and (f <> 0) then 
  3197.             r:=s * f * exp(-1022.0*ln(2.0)) * f
  3198.         else if (e = 0) and (e = 0) then
  3199.             r:=0.0
  3200.         else if (e = 255) and (f = 0) then
  3201.             r:=0.0 {inf}
  3202.         else {if e=255 and f<>0}
  3203.             r:=0.0; {nan}
  3204.         {$endc PowerPC}
  3205.         DoubleToReal:=r;
  3206.     end;
  3207.  
  3208.  
  3209.     procedure RealToDouble(rr: extended; var d:FakeDouble);
  3210.     {Converts an IEEE float to an IEEE double. Will not be needed
  3211.     when "8 Byte Doubles" work in the Metrowerks 68k compiler.}
  3212.     var
  3213.       i, s, e, f:LongInt;
  3214.       r:real;
  3215.       dd:double;
  3216.     begin
  3217.         {$ifc PowerPC}
  3218.         dd:=rr;
  3219.         d:=FakeDouble(dd);
  3220.         {$elsec PowerPC}
  3221.         r:=rr;
  3222.         i:=LongInt(r);
  3223.       s:=band(i,$80000000);
  3224.       e:=band(i,$7f800000);
  3225.         e:=bsr(e, 23);
  3226.         if e>255 then
  3227.             e:=255;
  3228.         e:=e-127+1023;
  3229.         e:=bsl(e, 20);
  3230.         f:=band(i, $7fffff);
  3231.         f:=bsr(f, 3);
  3232.         d[1]:=bor(s,bor(e,f));
  3233.         d[2]:=0;
  3234.         {if r<>0.0 then begin
  3235.             ShowMessage(StringOf(' e=', e,' f=', f)); wait(60);
  3236.         end;}
  3237.         {$endc PowerPC}
  3238.     end;
  3239.     
  3240.     
  3241. {$S Utilities2}
  3242. {Routines from here to the end of the file go in the Utilities2 segment}
  3243.  
  3244.     function MakeStackFromWindow: boolean;
  3245.     begin
  3246.         with info^ do begin
  3247.                 StackInfo := StackInfoPtr(NewPtr(SizeOf(StackInfoRec)));
  3248.                 if StackInfo = nil then begin
  3249.                         MakeStackFromWindow := false;
  3250.                         exit(MakeStackFromWindow);
  3251.                     end;
  3252.                 with StackInfo^ do begin
  3253.                         nSlices := 1;
  3254.                         CurrentSlice := 1;
  3255.                         PicBaseH[1] := PicBaseHandle;
  3256.                         SliceSpacing := 0.0;
  3257.                         FrameInterval := 0.0;
  3258.                         StackType := VolumeStack;
  3259.                     end;
  3260.                 PictureType := NewPicture;
  3261.                 MakeStackFromWindow := true;
  3262.             end;
  3263.     end;
  3264.  
  3265.     
  3266.     procedure SelectSlice (i: integer);
  3267.     begin
  3268.         with info^, info^.StackInfo^ do
  3269.             if i <= nSlices then begin
  3270.                     hunlock(PicBaseHandle);
  3271.                     PicBaseHandle := PicBaseH[i];
  3272.                     hlock(PicBaseHandle);
  3273.                     {$ifc PowerPC}
  3274.                     PicBaseAddr := PicBaseHandle^;
  3275.                     {$elsec}
  3276.                     PicBaseAddr := StripAddress(PicBaseHandle^);
  3277.                     {$endc}
  3278.                     osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
  3279.                 end;
  3280.     end;
  3281.  
  3282.  
  3283.     procedure UpdateWindowsMenuItem;
  3284.         var
  3285.             str: str255;
  3286.             picSize: LongInt;
  3287.     begin
  3288.         with info^ do begin
  3289.             PicSize := PixMapSize;
  3290.             if StackInfo <> nil then
  3291.                 PicSize := PicSize * StackInfo^.nSlices;
  3292.             if DataH <> nil then
  3293.                 PicSize := PicSize + PicSize * SizeOf(real);
  3294.             NumToString((PicSize + 511) div 1024, str);
  3295.             str := concat(title, '  ', str, 'K');
  3296.             SetMenuItemText(WindowsMenuH, PicNum + WindowsMenuItems + nTextWindows, str);
  3297.         end;
  3298.     end;
  3299.  
  3300.  
  3301.     function AddSlice (update: boolean): boolean;
  3302.         var
  3303.             i: integer;
  3304.             h: handle;
  3305.             isRoi: boolean;
  3306.     begin
  3307.         with info^, info^.StackInfo^ do begin
  3308.                 AddSlice := false;
  3309.                 if nSlices = MaxSlices then
  3310.                     exit(AddSlice);
  3311.                 isRoi := RoiShowing;
  3312.                 if isRoi then
  3313.                     KillRoi;
  3314.                 h := GetBigHandle(PixMapSize);
  3315.                 if h = nil then begin
  3316.                         PutError('Not enough memory available to add a slice to this stack.');
  3317.                         AbortMacro;
  3318.                         exit(AddSlice);
  3319.                     end;
  3320.                 for i := nSlices downto CurrentSlice + 1 do
  3321.                     PicBaseH[i + 1] := PicBaseH[i];
  3322.                 nSlices := nSlices + 1;
  3323.                 CurrentSlice := CurrentSlice + 1;
  3324.                 PicBaseH[CurrentSlice] := h;
  3325.                 SelectSlice(CurrentSlice);
  3326.                 if Update then begin
  3327.                         SelectAll(false);
  3328.                         DoOperation(EraseOp);
  3329.                         UpdatePicWindow;
  3330.                     end;
  3331.                 if (StackType = rgbStack) and (nSlices <> 3) then
  3332.                     StackType := VolumeStack;
  3333.                 UpdateTitleBar;
  3334.                 if isRoi then
  3335.                     RestoreRoi;
  3336.                 WhatToUndo := NothingToUndo;
  3337.                 AddSlice := true;
  3338.                 changes := true;
  3339.                 PictureType := NewPicture;
  3340.                 UpdateWindowsMenuItem;
  3341.             end;
  3342.     end;
  3343.     
  3344.     
  3345.     procedure AbortMacro;
  3346.     {If a macro is running, abort it.}
  3347.     begin
  3348.         macro := false;
  3349.     end;
  3350.     
  3351.     
  3352.     procedure TruncateString(var str: str255; len: integer);
  3353.     begin
  3354. {if length(str) > len then
  3355.     beep;}
  3356.             if length(str) > len then
  3357.             delete(str, len + 1, length(str) - len);
  3358.     end;
  3359.     
  3360.             
  3361.     procedure CloseVdig;
  3362.     {Closes the current video digitizer component and
  3363.     its associated offscreen graphics world.}
  3364.     var
  3365.         err: osErr;
  3366.     begin
  3367.         if fgPixMap <> nil then begin
  3368.             DisposeGWorld(osGWorld);
  3369.             osGWorld := nil;
  3370.             GWorldLUT := nil;
  3371.             fgPixMap := nil;
  3372.         end;
  3373.         if vdig <> nil then begin
  3374.             err := CloseComponent(vdig);
  3375.             vdig := nil;
  3376.         end;
  3377.         FrameGrabber := noFrameGrabber;
  3378.     end;
  3379.  
  3380.  
  3381. end.